Portfolio optimization is an important topic in Finance. Modern portfolio theory (MPT) states that investors are risk averse and given a level of risk, they will choose the portfolios that offer the most return. To do that we need to optimize the portfolios.

To perform the optimization we will need

So lets begin

Downloading data

First lets load our packages

# list.of.packages <- c('tidyverse','tidyquant', 'plotly','timetk','GA','xtable', 'textreadr','rvest','fGarch',"dplyr", "dygraphs", "quantmod", "TTR", 'zoo', 'tseries', 'fGarch','PEIP','tidyverse','gridExtra', 'gdata', 'xtable',"dygraphs") 
# new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
# if(length(new.packages) > 0) {install.packages(new.packages)}
# lapply(list.of.packages, require, character.only=T)

library('tidyverse')
## Warning: package 'tidyverse' was built under R version 4.3.3
## Warning: package 'readr' was built under R version 4.3.3
## Warning: package 'forcats' was built under R version 4.3.3
library('tidyquant')
## Warning: package 'tidyquant' was built under R version 4.3.3
## Warning: package 'xts' was built under R version 4.3.2
## Warning: package 'zoo' was built under R version 4.3.2
## Warning: package 'quantmod' was built under R version 4.3.2
## Warning: package 'TTR' was built under R version 4.3.2
## Warning: package 'PerformanceAnalytics' was built under R version 4.3.3
library('plotly')
## Warning: package 'plotly' was built under R version 4.3.3
library('timetk')
## Warning: package 'timetk' was built under R version 4.3.3
library('GA')
## Warning: package 'GA' was built under R version 4.3.3
library('xtable')
## Warning: package 'xtable' was built under R version 4.3.3
#library('textreadr')
library('rvest')
## Warning: package 'rvest' was built under R version 4.3.3
library('fGarch')
## Warning: package 'fGarch' was built under R version 4.3.3
library("dplyr")
library("dygraphs")
## Warning: package 'dygraphs' was built under R version 4.3.3
library("quantmod")
library("TTR")
library('zoo')
library('tseries')
## Warning: package 'tseries' was built under R version 4.3.2
library('fGarch')
library('PEIP')
## Warning: package 'PEIP' was built under R version 4.3.3
library('tidyverse')
library('gridExtra')
## Warning: package 'gridExtra' was built under R version 4.3.2
library('gdata')
## Warning: package 'gdata' was built under R version 4.3.2
library('xtable')
library("dygraphs")
# Load all the required functions needed get the results
## function to generate weight
# get_weights <- function(N){
#  return(diff(c(0, sort(runif(N-1, min = 0, max = 1)), 1)))
# }
get_weights <- function(N){
  w<- runif(N, min = 0, max = 1)
  return(w/sum(w))
}
# skewness correlation
skewrho <- function(X){
  skewrho.cor <- cor(X-mean(X), (X-mean(X))^2)
  return(skewrho.cor)
}

# sign correlation
rho.cal<-function(X){
  rho.hat<-cor(sign(X-mean(X)), X-mean(X))
  return(rho.hat)
}

# volatlity correlation
rho.vol<-function(X){
  rho.vol<-cor(abs(X-mean(X)), (X-mean(X))^2)
  return(rho.vol)
}

Simulation study for sign correlation and volatility correlation

# simulate normal, t(2), t(3), t(4), t(5)
sample <- 8000
sim.n <- rnorm (sample)     # sign correlation of a normal distribution is sqrt(2/pi)=0.7979
sim.t25 <- rt (sample, df = 2.5)
sim.t3 <- rt (sample, df = 3)
sim.t35 <- rt (sample, df = 3.5)
sim.t4 <- rt (sample, df = 4)
sim.t5 <- rt (sample, df = 5)
data <- cbind (sim.t25, sim.t3, sim.t35, sim.t4, sim.t5, sim.n)

skewrho<-apply(as.matrix(data), MARGIN=2, FUN=skewrho)
rhosign<-apply(as.matrix(data), MARGIN=2, FUN=rho.cal)
rhovol<-apply(as.matrix(data), MARGIN=2, FUN=rho.vol)

assetsummary<-data.frame(apply(data, 2, mean), apply(data, 2, sd), apply(data, 2, skewness), apply(data, 2, kurtosis), skewrho, rhovol, rhosign)
xtable(assetsummary, digits=4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:42:39 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrrr}
##   \hline
##  & apply.data..2..mean. & apply.data..2..sd. & apply.data..2..skewness. & apply.data..2..kurtosis. & skewrho & rhovol & rhosign \\ 
##   \hline
## sim.t25 & -0.0267 & 1.9191 & -0.8180 & 24.1708 & -0.1599 & 0.8066 & 0.6217 \\ 
##   sim.t3 & -0.0032 & 1.9364 & -11.2100 & 560.4174 & -0.4727 & 0.7005 & 0.5714 \\ 
##   sim.t35 & 0.0107 & 1.4827 & 0.0992 & 11.4017 & 0.0271 & 0.7884 & 0.6967 \\ 
##   sim.t4 & 0.0016 & 1.4409 & -0.2514 & 10.1092 & -0.0722 & 0.7818 & 0.7009 \\ 
##   sim.t5 & 0.0064 & 1.2512 & -0.0070 & 2.2021 & -0.0034 & 0.8944 & 0.7495 \\ 
##   sim.n & 0.0070 & 1.0019 & 0.0163 & 0.0329 & 0.0114 & 0.9354 & 0.7972 \\ 
##    \hline
## \end{tabular}
## \end{table}

Next lets select a few stocks to build our portfolios.

We will choose some stocks.

Lets download the price data.

Portfolio selected from DD_DBSCAN_2020_lowest_average_clustering

#Import data

DD_DBSCAN_2020_lowest_average_clustering <- read.csv("DD_DBSCAN_2020_lowest_average_clustering.csv")

#remove the date column
asset_prices<-DD_DBSCAN_2020_lowest_average_clustering[,-1]
# calculate returns
ret_tidy1 = apply(asset_prices,2, log)
head(ret_tidy1)
##          AAPL    GOOGL       KO     MSFT      PEP       PG        V
## [1,] 4.288761 4.223397 3.859717 5.036551 4.776059 4.697953 5.219480
## [2,] 4.278992 4.218152 3.854247 5.024021 4.774659 4.691205 5.211495
## [3,] 4.286928 4.244457 3.853881 5.026603 4.778485 4.692590 5.209331
## [4,] 4.282214 4.242523 3.846169 5.017443 4.762643 4.686380 5.206684
## [5,] 4.298172 4.249616 3.848010 5.033246 4.767778 4.690633 5.223657
## [6,] 4.319190 4.260059 3.866062 5.045662 4.768446 4.701512 5.230563
ret_tidy2 = diff(ret_tidy1)
head(ret_tidy2)
##              AAPL        GOOGL            KO         MSFT           PEP
## [1,] -0.009769385 -0.005245064 -0.0054707368 -0.012529783 -0.0013998362
## [2,]  0.007936156  0.026305039 -0.0003656689  0.002581361  0.0038264967
## [3,] -0.004713898 -0.001933350 -0.0077119723 -0.009159491 -0.0158427597
## [4,]  0.015957985  0.007092451  0.0018413843  0.015802856  0.0051355869
## [5,]  0.021018571  0.010443219  0.0180515221  0.012415835  0.0006677358
## [6,]  0.002258306  0.006437819  0.0034274624 -0.004637966 -0.0019306580
##                 PG            V
## [1,] -0.0067484304 -0.007984874
## [2,]  0.0013858279 -0.002164490
## [3,] -0.0062108168 -0.002646766
## [4,]  0.0042537293  0.016973121
## [5,]  0.0108786174  0.006906322
## [6,]  0.0009683657  0.002686991
ret_tidy = exp (ret_tidy2) - 1 #simple returns
#remove first row
asset_returns <- ret_tidy[-1,]

#no.of assets in the portfolio 
nasset<-ncol(asset_returns)

# testing and training data sets (each data set has 252 observations)
# Divide the data set in to 3:1 (75% training and 25% testing)
# testing period - January - September (189 data points)
# training period - October - December (62 data points)

n.total<-252
n.train<- 189

train = asset_returns[1:n.train,]
test = asset_returns[-(1:(n.train)),]
##summary statistics 
rhosign<-apply(as.matrix(train), MARGIN=2, FUN=rho.cal)
rhovol<-apply(as.matrix(train), MARGIN=2, FUN=rho.vol)
assetsummary<-data.frame(apply(train, 2, mean), apply(train, 2, sd), rhovol, rhosign, apply(train, 2, skewness),
                 apply(train, 2, kurtosis))
xtable(assetsummary, digits=4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:42:39 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrr}
##   \hline
##  & apply.train..2..mean. & apply.train..2..sd. & rhovol & rhosign & apply.train..2..skewness. & apply.train..2..kurtosis. \\ 
##   \hline
## AAPL & 0.0028 & 0.0317 & 0.9287 & 0.6937 & -0.0759 & 3.3262 \\ 
##   GOOGL & 0.0007 & 0.0261 & 0.9148 & 0.6923 & -0.2472 & 3.4690 \\ 
##   KO & -0.0001 & 0.0240 & 0.9260 & 0.6821 & -0.5320 & 2.4033 \\ 
##   MSFT & 0.0019 & 0.0306 & 0.9042 & 0.6814 & -0.0716 & 5.2156 \\ 
##   PEP & 0.0005 & 0.0261 & 0.9310 & 0.5788 & -0.0531 & 8.9090 \\ 
##   PG & 0.0010 & 0.0229 & 0.9207 & 0.5979 & 0.4069 & 6.6654 \\ 
##   V & 0.0008 & 0.0296 & 0.9089 & 0.6656 & 0.1974 & 5.4950 \\ 
##    \hline
## \end{tabular}
## \end{table}
plot(train, legend.loc=1)
## Warning in plot.window(...): "legend.loc" is not a graphical parameter
## Warning in plot.xy(xy, type, ...): "legend.loc" is not a graphical parameter
## Warning in axis(side = side, at = at, labels = labels, ...): "legend.loc" is
## not a graphical parameter

## Warning in axis(side = side, at = at, labels = labels, ...): "legend.loc" is
## not a graphical parameter
## Warning in box(...): "legend.loc" is not a graphical parameter
## Warning in title(...): "legend.loc" is not a graphical parameter

Lets calculate annualized portfolio return, risk, and gamma from the simulated portfolio returns with portfolio weights. (simulated weights)

## portfolio return, sd and gamma
## w is the random weight
## data = train or test
portfolio_info = function(w, data){
  port.data <- data%*%as.vector(w)
  port.cdf <- ecdf(port.data)
  port.return <- mean (port.data)
  port.sd <- sd (port.data)
  port.signrho <- cor (port.data - port.return, sign(port.data - port.return))
# port.signrho3 <- cor (sign(port.data - port.return), (port.data - port.return)^3)
# port.skewrho <- cor (port.data - port.return, (port.data - port.return)^2)
  port.volcor <- cor (abs(port.data - port.return), (port.data - port.return)^2) #volatlity correlation
  port.skewness <- skewness (port.data) #mu_3/sigma^3
  port.kurtosis <- kurtosis (port.data) #excess kurtosis mu_4/sigma^4 - 3
  return(c(port.return, port.sd, port.volcor, port.signrho, port.cdf(port.return), port.skewness, port.kurtosis))
}
# In stat matrix and weight matrix nrow = no.of assets in the portfolio (need to change), ncol is fixed to 7 , for loop i in 1:nrow
stat<-matrix(0, nrow = nasset, ncol = 7)
weight<-matrix(0, nrow = nasset, ncol = nasset)
for (i in 1:nasset){
weight[i, ] <- get_weights(nasset)
stat[i, ] <- portfolio_info (weight[i, ], as.matrix(train))
}
xtable(weight, digits = 4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:42:39 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 & 6 & 7 \\ 
##   \hline
## 1 & 0.2240 & 0.0835 & 0.2353 & 0.1601 & 0.0381 & 0.1636 & 0.0954 \\ 
##   2 & 0.2240 & 0.1266 & 0.2573 & 0.0391 & 0.1163 & 0.0922 & 0.1444 \\ 
##   3 & 0.1325 & 0.0366 & 0.0697 & 0.1529 & 0.1477 & 0.2164 & 0.2442 \\ 
##   4 & 0.1857 & 0.1689 & 0.0185 & 0.2344 & 0.1086 & 0.2045 & 0.0794 \\ 
##   5 & 0.1621 & 0.0440 & 0.0211 & 0.2682 & 0.2001 & 0.0733 & 0.2311 \\ 
##   6 & 0.1892 & 0.0458 & 0.1591 & 0.1852 & 0.1548 & 0.1196 & 0.1463 \\ 
##   7 & 0.0008 & 0.0475 & 0.1729 & 0.0824 & 0.1413 & 0.2786 & 0.2765 \\ 
##    \hline
## \end{tabular}
## \end{table}
xtable(stat, digits = 4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:42:39 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 & 6 & 7 \\ 
##   \hline
## 1 & 0.0012 & 0.0241 & 0.9309 & 0.6591 & 0.4127 & -0.2216 & 4.6915 \\ 
##   2 & 0.0010 & 0.0239 & 0.9328 & 0.6612 & 0.4074 & -0.3012 & 4.6865 \\ 
##   3 & 0.0012 & 0.0244 & 0.9281 & 0.6351 & 0.4339 & 0.0137 & 5.7248 \\ 
##   4 & 0.0014 & 0.0249 & 0.9233 & 0.6507 & 0.4286 & -0.0564 & 5.6526 \\ 
##   5 & 0.0013 & 0.0260 & 0.9204 & 0.6460 & 0.4180 & -0.0871 & 6.0475 \\ 
##   6 & 0.0012 & 0.0246 & 0.9293 & 0.6469 & 0.4233 & -0.1706 & 5.3809 \\ 
##   7 & 0.0007 & 0.0233 & 0.9340 & 0.6329 & 0.4497 & 0.0198 & 5.0784 \\ 
##    \hline
## \end{tabular}
## \end{table}

Check for the portfolio sd can be calcualted by both the formula and sd of the simulated portfolio.

We have everything we need to perform our optimization. All we need now is to run this code on 8000 random portfolios. For that we will use a for loop.

Before we do that, we need to create empty vectors and matrix for storing our values.

#change nasset to no of assets in portfolio
num_port <- 10000
nasset <- nasset

# Creating a matrix to store the weights

all_wts1 <- matrix(nrow = num_port,
                  ncol = nasset)

# Creating an empty vector to store
# 8000 Portfolio returns

port_returns <- vector('numeric', length = num_port)

# Creating an empty vector to store
# 8000 Portfolio variances

port_risk.var1 <- vector('numeric', length = num_port)
port_risk.var2 <- vector('numeric', length = num_port)
port_risk.var3 <- vector('numeric', length = num_port)
port_risk.var4 <- vector('numeric', length = num_port)
port_risk.mad <- vector('numeric', length = num_port)

Sharpe_ratio.sd1 <- vector('numeric', length = num_port)
Sharpe_ratio.sd2 <- vector('numeric', length = num_port)
Sharpe_ratio.sd3 <- vector('numeric', length = num_port)
Sharpe_ratio.sd4 <- vector('numeric', length = num_port)
Sharpe_ratio.mad <- vector('numeric', length = num_port)

Next lets run the for loop 10000 times.

port.info <- matrix(0, nrow = 10000, ncol = 7)

ptm <- proc.time()

for (i in seq_along(port_returns)) {
  
  wts <- get_weights(nasset)
  
  # Storing weight in the matrix
  all_wts1[i,] <- wts
  
  # Portfolio returns
  
  port.info [i, ]<- portfolio_info (wts, as.matrix(train))
  
  # Storing Portfolio Returns values
  port_returns[i] <- port.info[i, 1]
  
  # Creating and storing portfolio risk
  port_risk.var1 [i] <- port.info[i, 2]
  port_risk.var2 [i] <- sqrt(1 - port.info[i, 3]^2)*port.info[i, 2]
  port_risk.var3 [i] <- sqrt(1 - port.info[i, 4]^2)*port.info[i, 2]
  port_risk.var4 [i] <- sqrt(1 - port.info[i, 3]^2)*sqrt(1 - port.info[i, 4]^2)*port.info[i, 2]
  port_risk.mad [i] <- 2*port.info[i, 2]*port.info[i, 4]*sqrt(port.info[i, 5]*(1-port.info[i, 5]))
  
  # Creating and storing Portfolio Sharpe Ratios
  # Assuming 0% Risk free rate
  
  Sharpe_ratio.sd1 [i] <- port_returns[i]/port_risk.var1 [i]
  Sharpe_ratio.sd2 [i] <- port_returns[i]/port_risk.var2 [i]
  Sharpe_ratio.sd3 [i] <- port_returns[i]/port_risk.var3 [i]
  Sharpe_ratio.sd4 [i] <- port_returns[i]/port_risk.var4 [i]
  Sharpe_ratio.mad [i] <- port_returns[i]/port_risk.mad [i]
}
proc.time()-ptm
##    user  system elapsed 
##    1.86    0.04    5.81
port.info.data <- as.data.frame(port.info)

ggplot(port.info.data, aes(x=V6, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Skewness") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V7, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Kurtosis") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V6)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Skewness")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V7)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Kurtosis")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V2)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Volatility")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V2, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V2)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Volatlity")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V2)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Volatility")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V6)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Skewness")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V7)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Kurtosis")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

We now create a data table to store all the values together (using sd).

# Storing the values in the table (5 columns and 8000 rows)
portfolio_values1 <- tibble(Return = port_returns,
                  Risk1 = port_risk.var1,
                  Risk2 = port_risk.var2,
                  Risk3 = port_risk.var3,
                  Risk4 = port_risk.var4,
                  Risk5 = port_risk.mad,
                  SharpeRatio1 = Sharpe_ratio.sd1,
                  SharpeRatio2 = Sharpe_ratio.sd2,
                  SharpeRatio3 = Sharpe_ratio.sd3,
                  SharpeRatio4 = Sharpe_ratio.sd4,
                  SharpeRatio5 = Sharpe_ratio.mad,
                  )
# Converting matrix to a tibble and changing column names
all_wts1 <- tk_tbl(all_wts1)
## Warning in tk_tbl.data.frame(as.data.frame(data), preserve_index, rename_index,
## : Warning: No index to preserve. Object otherwise converted to tibble
## successfully.
colnames(all_wts1) <- colnames(asset_returns)

# Combing all the values together
portfolio_values1 <- tk_tbl(cbind(all_wts1, portfolio_values1))
## Warning in tk_tbl.data.frame(cbind(all_wts1, portfolio_values1)): Warning: No
## index to preserve. Object otherwise converted to tibble successfully.

We have the weights in each asset with the risk and returns along with the Sharpe ratio of each portfolio. We use daily data to determine the portfolios.

Next lets look at the portfolios that matter the most.

min_var1 <- portfolio_values1[which.min(portfolio_values1$Risk1),]
min_var2 <- portfolio_values1[which.min(portfolio_values1$Risk2),]
min_var3 <- portfolio_values1[which.min(portfolio_values1$Risk3),]
min_var4 <- portfolio_values1[which.min(portfolio_values1$Risk4),]
min_mad <- portfolio_values1[which.min(portfolio_values1$Risk5),]
max_sr1 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio1),]
max_sr2 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio2),]
max_sr3 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio3),]
max_sr4 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio4),]
max_sr5 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio5),]
rbind(min_var1, min_var2, min_var3, min_var4, min_mad, max_sr1, max_sr2, max_sr3, max_sr4, max_sr5)
## # A tibble: 10 × 18
##      AAPL   GOOGL     KO   MSFT      PEP    PG       V   Return  Risk1   Risk2
##     <dbl>   <dbl>  <dbl>  <dbl>    <dbl> <dbl>   <dbl>    <dbl>  <dbl>   <dbl>
##  1 0.0128 0.148   0.354  0.0420 0.0817   0.347 0.0142  0.000577 0.0218 0.00764
##  2 0.0128 0.148   0.354  0.0420 0.0817   0.347 0.0142  0.000577 0.0218 0.00764
##  3 0.0127 0.379   0.411  0.0256 0.0236   0.145 0.00301 0.000459 0.0222 0.00796
##  4 0.0617 0.296   0.311  0.0172 0.000975 0.266 0.0477  0.000673 0.0221 0.00777
##  5 0.0400 0.00405 0.192  0.0450 0.304    0.377 0.0381  0.000746 0.0227 0.00815
##  6 0.432  0.0269  0.0137 0.208  0.0744   0.224 0.0215  0.00188  0.0263 0.0102 
##  7 0.432  0.0269  0.0137 0.208  0.0744   0.224 0.0215  0.00188  0.0263 0.0102 
##  8 0.432  0.0269  0.0137 0.208  0.0744   0.224 0.0215  0.00188  0.0263 0.0102 
##  9 0.432  0.0269  0.0137 0.208  0.0744   0.224 0.0215  0.00188  0.0263 0.0102 
## 10 0.432  0.0269  0.0137 0.208  0.0744   0.224 0.0215  0.00188  0.0263 0.0102 
## # ℹ 8 more variables: Risk3 <dbl>, Risk4 <dbl>, Risk5 <dbl>,
## #   SharpeRatio1 <dbl>, SharpeRatio2 <dbl>, SharpeRatio3 <dbl>,
## #   SharpeRatio4 <dbl>, SharpeRatio5 <dbl>
xtable(rbind(min_var1, min_var2, min_var3, min_var4, min_mad, max_sr1, max_sr2, max_sr3, max_sr4, max_sr5), digits = 6)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:42:58 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrrrrrrrrrrrrrr}
##   \hline
##  & AAPL & GOOGL & KO & MSFT & PEP & PG & V & Return & Risk1 & Risk2 & Risk3 & Risk4 & Risk5 & SharpeRatio1 & SharpeRatio2 & SharpeRatio3 & SharpeRatio4 & SharpeRatio5 \\ 
##   \hline
## 1 & 0.012828 & 0.148403 & 0.353528 & 0.041965 & 0.081719 & 0.347340 & 0.014215 & 0.000577 & 0.021800 & 0.007639 & 0.016868 & 0.005911 & 0.013776 & 0.026490 & 0.075593 & 0.034235 & 0.097693 & 0.041919 \\ 
##   2 & 0.012828 & 0.148403 & 0.353528 & 0.041965 & 0.081719 & 0.347340 & 0.014215 & 0.000577 & 0.021800 & 0.007639 & 0.016868 & 0.005911 & 0.013776 & 0.026490 & 0.075593 & 0.034235 & 0.097693 & 0.041919 \\ 
##   3 & 0.012733 & 0.379007 & 0.410712 & 0.025583 & 0.023558 & 0.145397 & 0.003010 & 0.000459 & 0.022180 & 0.007957 & 0.016525 & 0.005928 & 0.014685 & 0.020686 & 0.057660 & 0.027766 & 0.077394 & 0.031244 \\ 
##   4 & 0.061676 & 0.295981 & 0.310954 & 0.017237 & 0.000975 & 0.265517 & 0.047660 & 0.000673 & 0.022098 & 0.007772 & 0.016671 & 0.005863 & 0.014398 & 0.030472 & 0.086641 & 0.040393 & 0.114850 & 0.046768 \\ 
##   5 & 0.040024 & 0.004049 & 0.192029 & 0.044992 & 0.303695 & 0.377127 & 0.038084 & 0.000746 & 0.022716 & 0.008149 & 0.018317 & 0.006571 & 0.013412 & 0.032858 & 0.091593 & 0.040749 & 0.113588 & 0.055652 \\ 
##   6 & 0.431511 & 0.026857 & 0.013659 & 0.207960 & 0.074392 & 0.224083 & 0.021540 & 0.001880 & 0.026262 & 0.010178 & 0.019719 & 0.007642 & 0.017216 & 0.071586 & 0.184712 & 0.095338 & 0.246001 & 0.109199 \\ 
##   7 & 0.431511 & 0.026857 & 0.013659 & 0.207960 & 0.074392 & 0.224083 & 0.021540 & 0.001880 & 0.026262 & 0.010178 & 0.019719 & 0.007642 & 0.017216 & 0.071586 & 0.184712 & 0.095338 & 0.246001 & 0.109199 \\ 
##   8 & 0.431511 & 0.026857 & 0.013659 & 0.207960 & 0.074392 & 0.224083 & 0.021540 & 0.001880 & 0.026262 & 0.010178 & 0.019719 & 0.007642 & 0.017216 & 0.071586 & 0.184712 & 0.095338 & 0.246001 & 0.109199 \\ 
##   9 & 0.431511 & 0.026857 & 0.013659 & 0.207960 & 0.074392 & 0.224083 & 0.021540 & 0.001880 & 0.026262 & 0.010178 & 0.019719 & 0.007642 & 0.017216 & 0.071586 & 0.184712 & 0.095338 & 0.246001 & 0.109199 \\ 
##   10 & 0.431511 & 0.026857 & 0.013659 & 0.207960 & 0.074392 & 0.224083 & 0.021540 & 0.001880 & 0.026262 & 0.010178 & 0.019719 & 0.007642 & 0.017216 & 0.071586 & 0.184712 & 0.095338 & 0.246001 & 0.109199 \\ 
##    \hline
## \end{tabular}
## \end{table}
# change min_var1[1:nassets] and all the indexes after that accordingly
p1 <- cbind(min_var1[1:nasset], 252*min_var1[nasset+1], sqrt(252)*min_var1[nasset+2], sqrt(252)*min_var1[nasset+7])
p2 <- cbind(min_var2[1:nasset], 252*min_var2[nasset+1], sqrt(252)*min_var2[nasset+3], sqrt(252)*min_var2[nasset+8])
p3 <- cbind(min_var3[1:nasset], 252*min_var3[nasset+1], sqrt(252)*min_var3[nasset+4], sqrt(252)*min_var3[nasset+9])
p4 <- cbind(min_var4[1:nasset], 252*min_var4[nasset+1], sqrt(252)*min_var4[nasset+5], sqrt(252)*min_var4[nasset+10])
p5 <- cbind(min_mad[1:nasset], 252*min_mad[nasset+1], sqrt(252)*min_mad[nasset+6], sqrt(252)*min_mad[nasset+11])
xtable(t(rbind(as.numeric(p1), as.numeric(p2), as.numeric(p3), as.numeric(p4), as.numeric(p5))), digits = 5)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:42:58 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 \\ 
##   \hline
## 1 & 0.01283 & 0.01283 & 0.01273 & 0.06168 & 0.04002 \\ 
##   2 & 0.14840 & 0.14840 & 0.37901 & 0.29598 & 0.00405 \\ 
##   3 & 0.35353 & 0.35353 & 0.41071 & 0.31095 & 0.19203 \\ 
##   4 & 0.04197 & 0.04197 & 0.02558 & 0.01724 & 0.04499 \\ 
##   5 & 0.08172 & 0.08172 & 0.02356 & 0.00097 & 0.30370 \\ 
##   6 & 0.34734 & 0.34734 & 0.14540 & 0.26552 & 0.37713 \\ 
##   7 & 0.01422 & 0.01422 & 0.00301 & 0.04766 & 0.03808 \\ 
##   8 & 0.14553 & 0.14553 & 0.11562 & 0.16969 & 0.18809 \\ 
##   9 & 0.34606 & 0.12127 & 0.26232 & 0.09307 & 0.21290 \\ 
##   10 & 0.42052 & 1.20000 & 0.44077 & 1.82319 & 0.88345 \\ 
##    \hline
## \end{tabular}
## \end{table}
# change max_sr[1:nassets] and all the indexes after that accordingly
p1 <- cbind(max_sr1[1:nasset], 252*max_sr1[nasset+1], sqrt(252)*max_sr1[nasset+2], sqrt(252)*max_sr1[nasset+7])
p2 <- cbind(max_sr2[1:nasset], 252*max_sr2[nasset+1], sqrt(252)*max_sr2[nasset+3], sqrt(252)*max_sr2[nasset+8])
p3 <- cbind(max_sr3[1:nasset], 252*max_sr3[nasset+1], sqrt(252)*max_sr3[nasset+4], sqrt(252)*max_sr3[nasset+9])
p4 <- cbind(max_sr4[1:nasset], 252*max_sr4[nasset+1], sqrt(252)*max_sr4[nasset+5], sqrt(252)*max_sr4[nasset+10])
p5 <- cbind(max_sr5[1:nasset], 252*max_sr5[nasset+1], sqrt(252)*max_sr5[nasset+6], sqrt(252)*max_sr5[nasset+11])
xtable(t(rbind(as.numeric(p1), as.numeric(p2), as.numeric(p3), as.numeric(p4), as.numeric(p5))), digits = 5)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:42:58 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 \\ 
##   \hline
## 1 & 0.43151 & 0.43151 & 0.43151 & 0.43151 & 0.43151 \\ 
##   2 & 0.02686 & 0.02686 & 0.02686 & 0.02686 & 0.02686 \\ 
##   3 & 0.01366 & 0.01366 & 0.01366 & 0.01366 & 0.01366 \\ 
##   4 & 0.20796 & 0.20796 & 0.20796 & 0.20796 & 0.20796 \\ 
##   5 & 0.07439 & 0.07439 & 0.07439 & 0.07439 & 0.07439 \\ 
##   6 & 0.22408 & 0.22408 & 0.22408 & 0.22408 & 0.22408 \\ 
##   7 & 0.02154 & 0.02154 & 0.02154 & 0.02154 & 0.02154 \\ 
##   8 & 0.47376 & 0.47376 & 0.47376 & 0.47376 & 0.47376 \\ 
##   9 & 0.41690 & 0.16157 & 0.31304 & 0.12132 & 0.27330 \\ 
##   10 & 1.13639 & 2.93221 & 1.51345 & 3.90514 & 1.73348 \\ 
##    \hline
## \end{tabular}
## \end{table}
nasset <- ncol(asset_returns)
w1 <- min_var1[, 1:nasset] %>% gather () %>% arrange(desc(value))
w2 <- min_var2[, 1:nasset] %>% gather () %>% arrange(desc(value))
w3 <- min_var3[, 1:nasset] %>% gather () %>% arrange(desc(value))
w4 <- min_var4[, 1:nasset] %>% gather () %>% arrange(desc(value))
w5 <- min_mad[, 1:nasset] %>% gather () %>% arrange(desc(value))
w6 <- max_sr1[, 1:nasset] %>% gather () %>% arrange(desc(value))
w7 <- max_sr2[, 1:nasset] %>% gather () %>% arrange(desc(value))
w8 <- max_sr3[, 1:nasset] %>% gather () %>% arrange(desc(value))
w9 <- max_sr4[, 1:nasset] %>% gather () %>% arrange(desc(value))
w10 <- max_sr5[, 1:nasset] %>% gather () %>% arrange(desc(value))

xtable(cbind(head (w1, 10), head (w2, 10), head (w3, 10), head (w4, 10), head (w5, 10), head (w6, 10), head (w7, 10), head (w8, 10), head (w9, 10), head (w10, 10)), digits = 4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:42:58 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrlrlrlrlrlrlrlrlrlr}
##   \hline
##  & key & value & key & value & key & value & key & value & key & value & key & value & key & value & key & value & key & value & key & value \\ 
##   \hline
## 1 & KO & 0.3535 & KO & 0.3535 & KO & 0.4107 & KO & 0.3110 & PG & 0.3771 & AAPL & 0.4315 & AAPL & 0.4315 & AAPL & 0.4315 & AAPL & 0.4315 & AAPL & 0.4315 \\ 
##   2 & PG & 0.3473 & PG & 0.3473 & GOOGL & 0.3790 & GOOGL & 0.2960 & PEP & 0.3037 & PG & 0.2241 & PG & 0.2241 & PG & 0.2241 & PG & 0.2241 & PG & 0.2241 \\ 
##   3 & GOOGL & 0.1484 & GOOGL & 0.1484 & PG & 0.1454 & PG & 0.2655 & KO & 0.1920 & MSFT & 0.2080 & MSFT & 0.2080 & MSFT & 0.2080 & MSFT & 0.2080 & MSFT & 0.2080 \\ 
##   4 & PEP & 0.0817 & PEP & 0.0817 & MSFT & 0.0256 & AAPL & 0.0617 & MSFT & 0.0450 & PEP & 0.0744 & PEP & 0.0744 & PEP & 0.0744 & PEP & 0.0744 & PEP & 0.0744 \\ 
##   5 & MSFT & 0.0420 & MSFT & 0.0420 & PEP & 0.0236 & V & 0.0477 & AAPL & 0.0400 & GOOGL & 0.0269 & GOOGL & 0.0269 & GOOGL & 0.0269 & GOOGL & 0.0269 & GOOGL & 0.0269 \\ 
##   6 & V & 0.0142 & V & 0.0142 & AAPL & 0.0127 & MSFT & 0.0172 & V & 0.0381 & V & 0.0215 & V & 0.0215 & V & 0.0215 & V & 0.0215 & V & 0.0215 \\ 
##   7 & AAPL & 0.0128 & AAPL & 0.0128 & V & 0.0030 & PEP & 0.0010 & GOOGL & 0.0040 & KO & 0.0137 & KO & 0.0137 & KO & 0.0137 & KO & 0.0137 & KO & 0.0137 \\ 
##    \hline
## \end{tabular}
## \end{table}

Lets plot the weights of each portfolio. First with the minimum variance portfolio.

p1 <- min_var4 %>%
  gather(colnames(asset_returns)[1]:colnames(asset_returns)[nasset], key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset,Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Minimum Risk Portfolio Weights") +
  scale_y_continuous(labels = scales::percent) 
ggplotly(p1)
p2 <- max_sr4 %>%
  gather(colnames(asset_returns)[1]:colnames(asset_returns)[nasset], key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset, Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Tangency Portfolio Weights") +
  scale_y_continuous(labels = scales::percent) 
ggplotly(p2)
#convert daily return, risk, SR to annualized ones

portfolio_values1_annual <- portfolio_values1 %>% mutate(Return = Return * 252) %>% mutate(Risk1 = Risk1 * sqrt(252), Risk2 = Risk2 * sqrt(252), Risk3 = Risk3 * sqrt(252), Risk4 = Risk4 * sqrt(252), Risk5 = Risk5 * sqrt(252)) %>% mutate(SharpeRatio1 = SharpeRatio1 * sqrt(252), SharpeRatio2 = SharpeRatio2 * sqrt(252), SharpeRatio3 = SharpeRatio3 * sqrt(252), SharpeRatio4 = SharpeRatio4 * sqrt(252), SharpeRatio5 = SharpeRatio5 * sqrt(252))
min_var1.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk1),]
min_var2.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk2),]
min_var3.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk3),]
min_var4.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk4),]
min_mad.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk5),]
max_sr1.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio1),]
max_sr2.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio2),]
max_sr3.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio3),]
max_sr4.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio4),]
max_sr5.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio5),]

rbind(min_var1.a, min_var2.a, min_var3.a, min_var4.a, min_mad.a, max_sr1.a, max_sr2.a, max_sr3.a, max_sr4.a, max_sr5.a)
## # A tibble: 10 × 18
##      AAPL   GOOGL     KO   MSFT      PEP    PG       V Return Risk1 Risk2 Risk3
##     <dbl>   <dbl>  <dbl>  <dbl>    <dbl> <dbl>   <dbl>  <dbl> <dbl> <dbl> <dbl>
##  1 0.0128 0.148   0.354  0.0420 0.0817   0.347 0.0142   0.146 0.346 0.121 0.268
##  2 0.0128 0.148   0.354  0.0420 0.0817   0.347 0.0142   0.146 0.346 0.121 0.268
##  3 0.0127 0.379   0.411  0.0256 0.0236   0.145 0.00301  0.116 0.352 0.126 0.262
##  4 0.0617 0.296   0.311  0.0172 0.000975 0.266 0.0477   0.170 0.351 0.123 0.265
##  5 0.0400 0.00405 0.192  0.0450 0.304    0.377 0.0381   0.188 0.361 0.129 0.291
##  6 0.432  0.0269  0.0137 0.208  0.0744   0.224 0.0215   0.474 0.417 0.162 0.313
##  7 0.432  0.0269  0.0137 0.208  0.0744   0.224 0.0215   0.474 0.417 0.162 0.313
##  8 0.432  0.0269  0.0137 0.208  0.0744   0.224 0.0215   0.474 0.417 0.162 0.313
##  9 0.432  0.0269  0.0137 0.208  0.0744   0.224 0.0215   0.474 0.417 0.162 0.313
## 10 0.432  0.0269  0.0137 0.208  0.0744   0.224 0.0215   0.474 0.417 0.162 0.313
## # ℹ 7 more variables: Risk4 <dbl>, Risk5 <dbl>, SharpeRatio1 <dbl>,
## #   SharpeRatio2 <dbl>, SharpeRatio3 <dbl>, SharpeRatio4 <dbl>,
## #   SharpeRatio5 <dbl>
p1 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk1, y = Return, color = SharpeRatio1)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (SD)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk1,
                 y = Return), data = min_var1.a, color = 'orange') +
  geom_point(aes(x = Risk1,
                 y = Return), data = max_sr1.a, color = 'orange4', shape = 18)
ggplotly(p1)
p2 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk2, y = Return, color = SharpeRatio2)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (VEV)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk2,
                 y = Return), data = min_var2.a, color = 'green') +
  geom_point(aes(x = Risk2,
                 y = Return), data = max_sr2.a, color = 'green4', shape = 18)
ggplotly(p2)
p3 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk3, y = Return, color = SharpeRatio3)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (VES)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk3,
                 y = Return), data = min_var3.a, color = 'red') +
  geom_point(aes(x = Risk3,
                 y = Return), data = max_sr3.a, color = 'red4', shape = 18)
ggplotly(p3)
p4 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk4, y = Return, color = SharpeRatio4)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (VESV)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk4,
                 y = Return), data = min_var4.a, color = 'purple') +
  geom_point(aes(x = Risk4,
                 y = Return), data = max_sr4.a, color = 'purple4', shape = 18)
ggplotly(p4)
p5 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk5, y = Return, color = SharpeRatio5)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (MAD)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk5,
                 y = Return), data = min_mad.a, color = 'blue') +
  geom_point(aes(x = Risk5,
                 y = Return), data = max_sr5.a, color = 'blue4', shape = 18)
ggplotly(p5)

Plots cummulative returns of the test sample

MVP1 <- as.matrix(test)%*%as.vector(as.numeric(min_var1[1:nasset]))
MVP2 <- as.matrix(test)%*%as.vector(as.numeric(min_var2[1:nasset]))
MVP3 <- as.matrix(test)%*%as.vector(as.numeric(min_var3[1:nasset]))
MVP4 <- as.matrix(test)%*%as.vector(as.numeric(min_var4[1:nasset]))
MVP5 <- as.matrix(test)%*%as.vector(as.numeric(min_mad[1:nasset]))
TP1<-as.matrix(test)%*%as.vector(as.numeric(max_sr1[1:nasset]))
TP2<-as.matrix(test)%*%as.vector(as.numeric(max_sr2[1:nasset]))
TP3<-as.matrix(test)%*%as.vector(as.numeric(max_sr3[1:nasset]))
TP4<-as.matrix(test)%*%as.vector(as.numeric(max_sr4[1:nasset]))
TP5<-as.matrix(test)%*%as.vector(as.numeric(max_sr5[1:nasset]))
EWQ<-as.matrix(test)%*%as.vector(rep(1/nasset, nasset))
assets <- c("MVP1", "MVP2", "MVP3", "MVP4", "MVP5", "TP1", "TP2", "TP3", "TP4", "TP5", "EWQ")

#Portfolios <- merge(test[, 1], cumsum(MVP1), cumsum(MVP2), cumsum(MVP3), cumsum(MVP4), cumsum(MVP5), cumsum(TP1), cumsum(TP2), cumsum(TP3), cumsum(TP4), cumsum(TP5), cumsum(EWQ))[, -c(1)]

Portfolios <- cbind.data.frame(cumsum(MVP1), cumsum(MVP2), cumsum(MVP3), cumsum(MVP4), cumsum(MVP5), cumsum(TP1), cumsum(TP2), cumsum(TP3), cumsum(TP4), cumsum(TP5), cumsum(EWQ))

colnames(Portfolios) <- assets
# Define start and end dates
start_date <- as.Date("2020-01-01")
end_date <- as.Date("2020-12-31")
# Create a sequence of dates
date_sequence <- seq(start_date, end_date, by = "day")
#date_sequence

# Number of last values to select
nTemp <- nrow(Portfolios)

# Select the last 'n' values from the vector
TestDates <- date_sequence[(length(date_sequence) - nTemp + 1):length(date_sequence)]
#TestDates
row.names(Portfolios) <- TestDates
dygraph(Portfolios, main = 'Cummulative Returns for Test Period')%>%
dySeries('MVP1', label = 'MVP', col = "orange") %>%
dySeries('MVP2', label = 'MRP2', col = "green") %>%
dySeries('MVP3', label = 'MRP3', col = "red") %>%  
dySeries('MVP4', label = 'MRP4', col = "purple") %>%
dySeries('MVP5', label = 'MRP5', col = "blue") %>%
dySeries('TP1', label = 'TP', col = "orange", drawPoints = TRUE) %>% 
dySeries('TP2', label = 'MRRP2', col = "green", drawPoints = TRUE) %>%
dySeries('TP3', label = 'MRRP3', col = "red", drawPoints = TRUE) %>%  
dySeries('TP4', label = 'MRRP4', col = "purple", drawPoints = TRUE) %>% 
dySeries('TP5', label = 'MRRP5', col = "blue", drawPoints = TRUE) %>%  
dySeries('EWQ', label = 'EWQ', col = "black") %>% 
dyRangeSelector(height = 30)%>%
  dyLegend(width = 500)

Choose cummulative return from volatility correlations - lowest average risk

CumReturnVolCorr_low_avg_risk <- cumsum(TP2)
CumReturnVolCorr_low_avg_risk
##  [1]  0.020233358  0.001569692  0.015858181  0.018907551  0.034878805
##  [6]  0.073132570  0.062953799  0.060302424  0.056113238  0.051400794
## [11]  0.029191664  0.036841934  0.036402767  0.031263600  0.031759153
## [16]  0.021849803  0.032992354 -0.010396707  0.008750449 -0.018196884
## [21] -0.014716259  0.002541725  0.031950861  0.057511598  0.058988375
## [26]  0.039686980  0.036873079  0.059450767  0.056837779  0.062655924
## [31]  0.065133198  0.057654728  0.044714647  0.048345869  0.040472663
## [36]  0.026603902  0.035979427  0.039931324  0.043750683  0.051227843
## [41]  0.069195370  0.067648160  0.064767460  0.064179681  0.069183660
## [46]  0.073705427  0.057276268  0.058765163  0.060417296  0.057393954
## [51]  0.080935271  0.086512504  0.091771004  0.085961161  0.091549949
## [56]  0.102245732  0.096532049  0.104632214  0.125845469  0.119112647
## [61]  0.112184625

Portfolio selected from DD_DBSCAN_2020_lowest_risk

#Import data

DD_DBSCAN_2020_lowest_risk <- read.csv("DD_DBSCAN_2020_lowest_risk.csv")

#remove the date column
asset_prices<-DD_DBSCAN_2020_lowest_risk[,-1]
# calculate returns
ret_tidy1 = apply(asset_prices,2, log)
head(ret_tidy1)
##          AMZN    GOOGL       KO      PEP       PG      UPS      WMT
## [1,] 4.552829 4.223397 3.859717 4.776059 4.697953 4.599936 3.607237
## [2,] 4.540616 4.218152 3.854247 4.774659 4.691205 4.599337 3.598370
## [3,] 4.555392 4.244457 3.853881 4.778485 4.692590 4.594872 3.596332
## [4,] 4.557481 4.242523 3.846169 4.762643 4.686380 4.593149 3.587025
## [5,] 4.549642 4.249616 3.848010 4.767778 4.690633 4.598823 3.583587
## [6,] 4.554429 4.260059 3.866062 4.768446 4.701512 4.601135 3.593864
ret_tidy2 = diff(ret_tidy1)
head(ret_tidy2)
##              AMZN        GOOGL            KO           PEP            PG
## [1,] -0.012213314 -0.005245064 -0.0054707368 -0.0013998362 -0.0067484304
## [2,]  0.014775871  0.026305039 -0.0003656689  0.0038264967  0.0013858279
## [3,]  0.002089436 -0.001933350 -0.0077119723 -0.0158427597 -0.0062108168
## [4,] -0.007839287  0.007092451  0.0018413843  0.0051355869  0.0042537293
## [5,]  0.004787695  0.010443219  0.0180515221  0.0006677358  0.0108786174
## [6,] -0.009455156  0.006437819  0.0034274624 -0.0019306580  0.0009683657
##                UPS          WMT
## [1,] -0.0005993921 -0.008867082
## [2,] -0.0044651876 -0.002038118
## [3,] -0.0017224533 -0.009307758
## [4,]  0.0056735024 -0.003437463
## [5,]  0.0023116211  0.010277351
## [6,] -0.0091064735 -0.008385591
ret_tidy = exp (ret_tidy2) - 1 #simple returns
#remove first row
asset_returns <- ret_tidy[-1,]

#no.of assets in the portfolio 
nasset<-ncol(asset_returns)

# testing and training data sets (each data set has 252 observations)
# Divide the data set in to 3:1 (75% training and 25% testing)
# testing period - January - September (189 data points)
# training period - October - December (62 data points)

n.total<-252
n.train<- 189

train = asset_returns[1:n.train,]
test = asset_returns[-(1:(n.train)),]
##summary statistics 
rhosign<-apply(as.matrix(train), MARGIN=2, FUN=rho.cal)
rhovol<-apply(as.matrix(train), MARGIN=2, FUN=rho.vol)
assetsummary<-data.frame(apply(train, 2, mean), apply(train, 2, sd), rhovol, rhosign, apply(train, 2, skewness),
                 apply(train, 2, kurtosis))
xtable(assetsummary, digits=4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:01 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrr}
##   \hline
##  & apply.train..2..mean. & apply.train..2..sd. & rhovol & rhosign & apply.train..2..skewness. & apply.train..2..kurtosis. \\ 
##   \hline
## AMZN & 0.0030 & 0.0253 & 0.9367 & 0.7448 & 0.0705 & 1.0722 \\ 
##   GOOGL & 0.0007 & 0.0261 & 0.9148 & 0.6923 & -0.2472 & 3.4690 \\ 
##   KO & -0.0001 & 0.0240 & 0.9260 & 0.6821 & -0.5320 & 2.4033 \\ 
##   PEP & 0.0005 & 0.0261 & 0.9310 & 0.5788 & -0.0531 & 8.9090 \\ 
##   PG & 0.0010 & 0.0229 & 0.9207 & 0.5979 & 0.4069 & 6.6654 \\ 
##   UPS & 0.0024 & 0.0279 & 0.8975 & 0.6523 & 0.9737 & 4.8973 \\ 
##   WMT & 0.0012 & 0.0223 & 0.9155 & 0.6309 & 1.1030 & 7.1737 \\ 
##    \hline
## \end{tabular}
## \end{table}
plot(train, legend.loc=1)
## Warning in plot.window(...): "legend.loc" is not a graphical parameter
## Warning in plot.xy(xy, type, ...): "legend.loc" is not a graphical parameter
## Warning in axis(side = side, at = at, labels = labels, ...): "legend.loc" is
## not a graphical parameter

## Warning in axis(side = side, at = at, labels = labels, ...): "legend.loc" is
## not a graphical parameter
## Warning in box(...): "legend.loc" is not a graphical parameter
## Warning in title(...): "legend.loc" is not a graphical parameter

Lets calculate annualized portfolio return, risk, and gamma from the simulated portfolio returns with portfolio weights. (simulated weights)

## portfolio return, sd and gamma
## w is the random weight
## data = train or test
portfolio_info = function(w, data){
  port.data <- data%*%as.vector(w)
  port.cdf <- ecdf(port.data)
  port.return <- mean (port.data)
  port.sd <- sd (port.data)
  port.signrho <- cor (port.data - port.return, sign(port.data - port.return))
# port.signrho3 <- cor (sign(port.data - port.return), (port.data - port.return)^3)
# port.skewrho <- cor (port.data - port.return, (port.data - port.return)^2)
  port.volcor <- cor (abs(port.data - port.return), (port.data - port.return)^2) #volatlity correlation
  port.skewness <- skewness (port.data) #mu_3/sigma^3
  port.kurtosis <- kurtosis (port.data) #excess kurtosis mu_4/sigma^4 - 3
  return(c(port.return, port.sd, port.volcor, port.signrho, port.cdf(port.return), port.skewness, port.kurtosis))
}
# In stat matrix and weight matrix nrow = no.of assets in the portfolio (need to change), ncol is fixed to 7 , for loop i in 1:nrow
stat<-matrix(0, nrow = nasset, ncol = 7)
weight<-matrix(0, nrow = nasset, ncol = nasset)
for (i in 1:nasset){
weight[i, ] <- get_weights(nasset)
stat[i, ] <- portfolio_info (weight[i, ], as.matrix(train))
}
xtable(weight, digits = 4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:01 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 & 6 & 7 \\ 
##   \hline
## 1 & 0.0726 & 0.2707 & 0.0796 & 0.2382 & 0.0727 & 0.1280 & 0.1381 \\ 
##   2 & 0.1208 & 0.0907 & 0.1474 & 0.0995 & 0.3013 & 0.1855 & 0.0548 \\ 
##   3 & 0.0434 & 0.2467 & 0.0232 & 0.0505 & 0.0437 & 0.3968 & 0.1957 \\ 
##   4 & 0.0646 & 0.2365 & 0.1007 & 0.1962 & 0.1678 & 0.0030 & 0.2311 \\ 
##   5 & 0.1073 & 0.0179 & 0.2025 & 0.2143 & 0.1153 & 0.1670 & 0.1756 \\ 
##   6 & 0.3401 & 0.1105 & 0.0373 & 0.0144 & 0.0980 & 0.2926 & 0.1070 \\ 
##   7 & 0.1482 & 0.1803 & 0.1746 & 0.1823 & 0.0699 & 0.0079 & 0.2368 \\ 
##    \hline
## \end{tabular}
## \end{table}
xtable(stat, digits = 4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:01 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 & 6 & 7 \\ 
##   \hline
## 1 & 0.0011 & 0.0211 & 0.9273 & 0.6265 & 0.4392 & 0.0147 & 5.9413 \\ 
##   2 & 0.0013 & 0.0205 & 0.9280 & 0.6225 & 0.4444 & 0.2142 & 5.0169 \\ 
##   3 & 0.0016 & 0.0213 & 0.9157 & 0.6451 & 0.4603 & 0.3878 & 4.5852 \\ 
##   4 & 0.0009 & 0.0206 & 0.9276 & 0.6142 & 0.4392 & 0.0289 & 6.7285 \\ 
##   5 & 0.0012 & 0.0203 & 0.9247 & 0.6077 & 0.4868 & 0.1892 & 6.0638 \\ 
##   6 & 0.0020 & 0.0206 & 0.9180 & 0.6627 & 0.4709 & 0.1893 & 3.4579 \\ 
##   7 & 0.0010 & 0.0201 & 0.9249 & 0.6207 & 0.4392 & -0.1081 & 6.2023 \\ 
##    \hline
## \end{tabular}
## \end{table}

Check for the portfolio sd can be calcualted by both the formula and sd of the simulated portfolio.

We have everything we need to perform our optimization. All we need now is to run this code on 8000 random portfolios. For that we will use a for loop.

Before we do that, we need to create empty vectors and matrix for storing our values.

#change nasset to no of assets in portfolio
num_port <- 10000
nasset <- nasset

# Creating a matrix to store the weights

all_wts1 <- matrix(nrow = num_port,
                  ncol = nasset)

# Creating an empty vector to store
# 8000 Portfolio returns

port_returns <- vector('numeric', length = num_port)

# Creating an empty vector to store
# 8000 Portfolio variances

port_risk.var1 <- vector('numeric', length = num_port)
port_risk.var2 <- vector('numeric', length = num_port)
port_risk.var3 <- vector('numeric', length = num_port)
port_risk.var4 <- vector('numeric', length = num_port)
port_risk.mad <- vector('numeric', length = num_port)

Sharpe_ratio.sd1 <- vector('numeric', length = num_port)
Sharpe_ratio.sd2 <- vector('numeric', length = num_port)
Sharpe_ratio.sd3 <- vector('numeric', length = num_port)
Sharpe_ratio.sd4 <- vector('numeric', length = num_port)
Sharpe_ratio.mad <- vector('numeric', length = num_port)

Next lets run the for loop 10000 times.

port.info <- matrix(0, nrow = 10000, ncol = 7)

ptm <- proc.time()

for (i in seq_along(port_returns)) {
  
  wts <- get_weights(nasset)
  
  # Storing weight in the matrix
  all_wts1[i,] <- wts
  
  # Portfolio returns
  
  port.info [i, ]<- portfolio_info (wts, as.matrix(train))
  
  # Storing Portfolio Returns values
  port_returns[i] <- port.info[i, 1]
  
  # Creating and storing portfolio risk
  port_risk.var1 [i] <- port.info[i, 2]
  port_risk.var2 [i] <- sqrt(1 - port.info[i, 3]^2)*port.info[i, 2]
  port_risk.var3 [i] <- sqrt(1 - port.info[i, 4]^2)*port.info[i, 2]
  port_risk.var4 [i] <- sqrt(1 - port.info[i, 3]^2)*sqrt(1 - port.info[i, 4]^2)*port.info[i, 2]
  port_risk.mad [i] <- 2*port.info[i, 2]*port.info[i, 4]*sqrt(port.info[i, 5]*(1-port.info[i, 5]))
  
  # Creating and storing Portfolio Sharpe Ratios
  # Assuming 0% Risk free rate
  
  Sharpe_ratio.sd1 [i] <- port_returns[i]/port_risk.var1 [i]
  Sharpe_ratio.sd2 [i] <- port_returns[i]/port_risk.var2 [i]
  Sharpe_ratio.sd3 [i] <- port_returns[i]/port_risk.var3 [i]
  Sharpe_ratio.sd4 [i] <- port_returns[i]/port_risk.var4 [i]
  Sharpe_ratio.mad [i] <- port_returns[i]/port_risk.mad [i]
}
proc.time()-ptm
##    user  system elapsed 
##    1.17    0.04    4.23
port.info.data <- as.data.frame(port.info)

ggplot(port.info.data, aes(x=V6, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Skewness") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V7, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Kurtosis") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V6)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Skewness")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V7)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Kurtosis")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V2)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Volatility")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V2, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V2)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Volatlity")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V2)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Volatility")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V6)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Skewness")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V7)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Kurtosis")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

We now create a data table to store all the values together (using sd).

# Storing the values in the table (5 columns and 8000 rows)
portfolio_values1 <- tibble(Return = port_returns,
                  Risk1 = port_risk.var1,
                  Risk2 = port_risk.var2,
                  Risk3 = port_risk.var3,
                  Risk4 = port_risk.var4,
                  Risk5 = port_risk.mad,
                  SharpeRatio1 = Sharpe_ratio.sd1,
                  SharpeRatio2 = Sharpe_ratio.sd2,
                  SharpeRatio3 = Sharpe_ratio.sd3,
                  SharpeRatio4 = Sharpe_ratio.sd4,
                  SharpeRatio5 = Sharpe_ratio.mad,
                  )
# Converting matrix to a tibble and changing column names
all_wts1 <- tk_tbl(all_wts1)
## Warning in tk_tbl.data.frame(as.data.frame(data), preserve_index, rename_index,
## : Warning: No index to preserve. Object otherwise converted to tibble
## successfully.
colnames(all_wts1) <- colnames(asset_returns)

# Combing all the values together
portfolio_values1 <- tk_tbl(cbind(all_wts1, portfolio_values1))
## Warning in tk_tbl.data.frame(cbind(all_wts1, portfolio_values1)): Warning: No
## index to preserve. Object otherwise converted to tibble successfully.

We have the weights in each asset with the risk and returns along with the Sharpe ratio of each portfolio. We use daily data to determine the portfolios.

Next lets look at the portfolios that matter the most.

min_var1 <- portfolio_values1[which.min(portfolio_values1$Risk1),]
min_var2 <- portfolio_values1[which.min(portfolio_values1$Risk2),]
min_var3 <- portfolio_values1[which.min(portfolio_values1$Risk3),]
min_var4 <- portfolio_values1[which.min(portfolio_values1$Risk4),]
min_mad <- portfolio_values1[which.min(portfolio_values1$Risk5),]
max_sr1 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio1),]
max_sr2 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio2),]
max_sr3 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio3),]
max_sr4 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio4),]
max_sr5 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio5),]
rbind(min_var1, min_var2, min_var3, min_var4, min_mad, max_sr1, max_sr2, max_sr3, max_sr4, max_sr5)
## # A tibble: 10 × 18
##      AMZN   GOOGL     KO     PEP      PG    UPS     WMT   Return  Risk1   Risk2
##     <dbl>   <dbl>  <dbl>   <dbl>   <dbl>  <dbl>   <dbl>    <dbl>  <dbl>   <dbl>
##  1 0.278  0.0103  0.239  0.0367  0.0953  0.0620 0.279   0.00143  0.0190 0.00757
##  2 0.0896 0.00494 0.468  0.00324 0.0937  0.137  0.204   0.000899 0.0197 0.00704
##  3 0.359  0.0111  0.130  0.0305  0.00454 0.111  0.353   0.00181  0.0192 0.00792
##  4 0.118  0.0488  0.421  0.0210  0.0639  0.323  0.00418 0.00120  0.0210 0.00706
##  5 0.164  0.00889 0.207  0.0224  0.331   0.0214 0.246   0.00117  0.0194 0.00752
##  6 0.579  0.0443  0.0692 0.0208  0.0524  0.126  0.108   0.00228  0.0209 0.00797
##  7 0.579  0.0443  0.0692 0.0208  0.0524  0.126  0.108   0.00228  0.0209 0.00797
##  8 0.579  0.0443  0.0692 0.0208  0.0524  0.126  0.108   0.00228  0.0209 0.00797
##  9 0.579  0.0443  0.0692 0.0208  0.0524  0.126  0.108   0.00228  0.0209 0.00797
## 10 0.396  0.0119  0.0197 0.0849  0.0981  0.382  0.00717 0.00228  0.0215 0.00852
## # ℹ 8 more variables: Risk3 <dbl>, Risk4 <dbl>, Risk5 <dbl>,
## #   SharpeRatio1 <dbl>, SharpeRatio2 <dbl>, SharpeRatio3 <dbl>,
## #   SharpeRatio4 <dbl>, SharpeRatio5 <dbl>
xtable(rbind(min_var1, min_var2, min_var3, min_var4, min_mad, max_sr1, max_sr2, max_sr3, max_sr4, max_sr5), digits = 6)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:18 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrrrrrrrrrrrrrr}
##   \hline
##  & AMZN & GOOGL & KO & PEP & PG & UPS & WMT & Return & Risk1 & Risk2 & Risk3 & Risk4 & Risk5 & SharpeRatio1 & SharpeRatio2 & SharpeRatio3 & SharpeRatio4 & SharpeRatio5 \\ 
##   \hline
## 1 & 0.277506 & 0.010327 & 0.239297 & 0.036682 & 0.095338 & 0.062004 & 0.278847 & 0.001429 & 0.018970 & 0.007566 & 0.014717 & 0.005870 & 0.011949 & 0.075346 & 0.188898 & 0.097120 & 0.243488 & 0.119614 \\ 
##   2 & 0.089650 & 0.004940 & 0.467601 & 0.003235 & 0.093665 & 0.137283 & 0.203626 & 0.000899 & 0.019685 & 0.007041 & 0.014976 & 0.005357 & 0.012776 & 0.045689 & 0.127732 & 0.060057 & 0.167900 & 0.070397 \\ 
##   3 & 0.358636 & 0.011091 & 0.130484 & 0.030532 & 0.004542 & 0.111414 & 0.353301 & 0.001806 & 0.019192 & 0.007921 & 0.014489 & 0.005980 & 0.012571 & 0.094116 & 0.228032 & 0.124661 & 0.302041 & 0.143684 \\ 
##   4 & 0.118011 & 0.048803 & 0.421269 & 0.020981 & 0.063852 & 0.322901 & 0.004183 & 0.001202 & 0.021048 & 0.007064 & 0.015536 & 0.005215 & 0.014184 & 0.057131 & 0.170219 & 0.077399 & 0.230607 & 0.084779 \\ 
##   5 & 0.163547 & 0.008885 & 0.206883 & 0.022381 & 0.330539 & 0.021432 & 0.246333 & 0.001174 & 0.019393 & 0.007521 & 0.015434 & 0.005985 & 0.011730 & 0.060557 & 0.156148 & 0.076094 & 0.196212 & 0.100118 \\ 
##   6 & 0.578990 & 0.044343 & 0.069164 & 0.020833 & 0.052412 & 0.126046 & 0.108212 & 0.002277 & 0.020887 & 0.007967 & 0.014997 & 0.005721 & 0.014514 & 0.108993 & 0.285730 & 0.151800 & 0.397951 & 0.156855 \\ 
##   7 & 0.578990 & 0.044343 & 0.069164 & 0.020833 & 0.052412 & 0.126046 & 0.108212 & 0.002277 & 0.020887 & 0.007967 & 0.014997 & 0.005721 & 0.014514 & 0.108993 & 0.285730 & 0.151800 & 0.397951 & 0.156855 \\ 
##   8 & 0.578990 & 0.044343 & 0.069164 & 0.020833 & 0.052412 & 0.126046 & 0.108212 & 0.002277 & 0.020887 & 0.007967 & 0.014997 & 0.005721 & 0.014514 & 0.108993 & 0.285730 & 0.151800 & 0.397951 & 0.156855 \\ 
##   9 & 0.578990 & 0.044343 & 0.069164 & 0.020833 & 0.052412 & 0.126046 & 0.108212 & 0.002277 & 0.020887 & 0.007967 & 0.014997 & 0.005721 & 0.014514 & 0.108993 & 0.285730 & 0.151800 & 0.397951 & 0.156855 \\ 
##   10 & 0.396438 & 0.011928 & 0.019683 & 0.084893 & 0.098106 & 0.381787 & 0.007165 & 0.002281 & 0.021454 & 0.008519 & 0.015990 & 0.006349 & 0.014303 & 0.106315 & 0.267749 & 0.142641 & 0.359233 & 0.159469 \\ 
##    \hline
## \end{tabular}
## \end{table}
# change min_var1[1:nassets] and all the indexes after that accordingly
p1 <- cbind(min_var1[1:nasset], 252*min_var1[nasset+1], sqrt(252)*min_var1[nasset+2], sqrt(252)*min_var1[nasset+7])
p2 <- cbind(min_var2[1:nasset], 252*min_var2[nasset+1], sqrt(252)*min_var2[nasset+3], sqrt(252)*min_var2[nasset+8])
p3 <- cbind(min_var3[1:nasset], 252*min_var3[nasset+1], sqrt(252)*min_var3[nasset+4], sqrt(252)*min_var3[nasset+9])
p4 <- cbind(min_var4[1:nasset], 252*min_var4[nasset+1], sqrt(252)*min_var4[nasset+5], sqrt(252)*min_var4[nasset+10])
p5 <- cbind(min_mad[1:nasset], 252*min_mad[nasset+1], sqrt(252)*min_mad[nasset+6], sqrt(252)*min_mad[nasset+11])
xtable(t(rbind(as.numeric(p1), as.numeric(p2), as.numeric(p3), as.numeric(p4), as.numeric(p5))), digits = 5)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:18 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 \\ 
##   \hline
## 1 & 0.27751 & 0.08965 & 0.35864 & 0.11801 & 0.16355 \\ 
##   2 & 0.01033 & 0.00494 & 0.01109 & 0.04880 & 0.00889 \\ 
##   3 & 0.23930 & 0.46760 & 0.13048 & 0.42127 & 0.20688 \\ 
##   4 & 0.03668 & 0.00324 & 0.03053 & 0.02098 & 0.02238 \\ 
##   5 & 0.09534 & 0.09366 & 0.00454 & 0.06385 & 0.33054 \\ 
##   6 & 0.06200 & 0.13728 & 0.11141 & 0.32290 & 0.02143 \\ 
##   7 & 0.27885 & 0.20363 & 0.35330 & 0.00418 & 0.24633 \\ 
##   8 & 0.36018 & 0.22665 & 0.45517 & 0.30303 & 0.29595 \\ 
##   9 & 0.30113 & 0.11178 & 0.23001 & 0.08278 & 0.18621 \\ 
##   10 & 1.19608 & 2.02769 & 1.97894 & 3.66076 & 1.58932 \\ 
##    \hline
## \end{tabular}
## \end{table}
# change max_sr[1:nassets] and all the indexes after that accordingly
p1 <- cbind(max_sr1[1:nasset], 252*max_sr1[nasset+1], sqrt(252)*max_sr1[nasset+2], sqrt(252)*max_sr1[nasset+7])
p2 <- cbind(max_sr2[1:nasset], 252*max_sr2[nasset+1], sqrt(252)*max_sr2[nasset+3], sqrt(252)*max_sr2[nasset+8])
p3 <- cbind(max_sr3[1:nasset], 252*max_sr3[nasset+1], sqrt(252)*max_sr3[nasset+4], sqrt(252)*max_sr3[nasset+9])
p4 <- cbind(max_sr4[1:nasset], 252*max_sr4[nasset+1], sqrt(252)*max_sr4[nasset+5], sqrt(252)*max_sr4[nasset+10])
p5 <- cbind(max_sr5[1:nasset], 252*max_sr5[nasset+1], sqrt(252)*max_sr5[nasset+6], sqrt(252)*max_sr5[nasset+11])
xtable(t(rbind(as.numeric(p1), as.numeric(p2), as.numeric(p3), as.numeric(p4), as.numeric(p5))), digits = 5)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:18 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 \\ 
##   \hline
## 1 & 0.57899 & 0.57899 & 0.57899 & 0.57899 & 0.39644 \\ 
##   2 & 0.04434 & 0.04434 & 0.04434 & 0.04434 & 0.01193 \\ 
##   3 & 0.06916 & 0.06916 & 0.06916 & 0.06916 & 0.01968 \\ 
##   4 & 0.02083 & 0.02083 & 0.02083 & 0.02083 & 0.08489 \\ 
##   5 & 0.05241 & 0.05241 & 0.05241 & 0.05241 & 0.09811 \\ 
##   6 & 0.12605 & 0.12605 & 0.12605 & 0.12605 & 0.38179 \\ 
##   7 & 0.10821 & 0.10821 & 0.10821 & 0.10821 & 0.00717 \\ 
##   8 & 0.57369 & 0.57369 & 0.57369 & 0.57369 & 0.57477 \\ 
##   9 & 0.33157 & 0.12648 & 0.23807 & 0.09081 & 0.22705 \\ 
##   10 & 1.73020 & 4.53582 & 2.40975 & 6.31728 & 2.53149 \\ 
##    \hline
## \end{tabular}
## \end{table}
nasset <- ncol(asset_returns)
w1 <- min_var1[, 1:nasset] %>% gather () %>% arrange(desc(value))
w2 <- min_var2[, 1:nasset] %>% gather () %>% arrange(desc(value))
w3 <- min_var3[, 1:nasset] %>% gather () %>% arrange(desc(value))
w4 <- min_var4[, 1:nasset] %>% gather () %>% arrange(desc(value))
w5 <- min_mad[, 1:nasset] %>% gather () %>% arrange(desc(value))
w6 <- max_sr1[, 1:nasset] %>% gather () %>% arrange(desc(value))
w7 <- max_sr2[, 1:nasset] %>% gather () %>% arrange(desc(value))
w8 <- max_sr3[, 1:nasset] %>% gather () %>% arrange(desc(value))
w9 <- max_sr4[, 1:nasset] %>% gather () %>% arrange(desc(value))
w10 <- max_sr5[, 1:nasset] %>% gather () %>% arrange(desc(value))

xtable(cbind(head (w1, 10), head (w2, 10), head (w3, 10), head (w4, 10), head (w5, 10), head (w6, 10), head (w7, 10), head (w8, 10), head (w9, 10), head (w10, 10)), digits = 4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:19 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrlrlrlrlrlrlrlrlrlr}
##   \hline
##  & key & value & key & value & key & value & key & value & key & value & key & value & key & value & key & value & key & value & key & value \\ 
##   \hline
## 1 & WMT & 0.2788 & KO & 0.4676 & AMZN & 0.3586 & KO & 0.4213 & PG & 0.3305 & AMZN & 0.5790 & AMZN & 0.5790 & AMZN & 0.5790 & AMZN & 0.5790 & AMZN & 0.3964 \\ 
##   2 & AMZN & 0.2775 & WMT & 0.2036 & WMT & 0.3533 & UPS & 0.3229 & WMT & 0.2463 & UPS & 0.1260 & UPS & 0.1260 & UPS & 0.1260 & UPS & 0.1260 & UPS & 0.3818 \\ 
##   3 & KO & 0.2393 & UPS & 0.1373 & KO & 0.1305 & AMZN & 0.1180 & KO & 0.2069 & WMT & 0.1082 & WMT & 0.1082 & WMT & 0.1082 & WMT & 0.1082 & PG & 0.0981 \\ 
##   4 & PG & 0.0953 & PG & 0.0937 & UPS & 0.1114 & PG & 0.0639 & AMZN & 0.1635 & KO & 0.0692 & KO & 0.0692 & KO & 0.0692 & KO & 0.0692 & PEP & 0.0849 \\ 
##   5 & UPS & 0.0620 & AMZN & 0.0896 & PEP & 0.0305 & GOOGL & 0.0488 & PEP & 0.0224 & PG & 0.0524 & PG & 0.0524 & PG & 0.0524 & PG & 0.0524 & KO & 0.0197 \\ 
##   6 & PEP & 0.0367 & GOOGL & 0.0049 & GOOGL & 0.0111 & PEP & 0.0210 & UPS & 0.0214 & GOOGL & 0.0443 & GOOGL & 0.0443 & GOOGL & 0.0443 & GOOGL & 0.0443 & GOOGL & 0.0119 \\ 
##   7 & GOOGL & 0.0103 & PEP & 0.0032 & PG & 0.0045 & WMT & 0.0042 & GOOGL & 0.0089 & PEP & 0.0208 & PEP & 0.0208 & PEP & 0.0208 & PEP & 0.0208 & WMT & 0.0072 \\ 
##    \hline
## \end{tabular}
## \end{table}

Lets plot the weights of each portfolio. First with the minimum variance portfolio.

p1 <- min_var4 %>%
  gather(colnames(asset_returns)[1]:colnames(asset_returns)[nasset], key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset,Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Minimum Risk Portfolio Weights") +
  scale_y_continuous(labels = scales::percent) 
ggplotly(p1)
p2 <- max_sr4 %>%
  gather(colnames(asset_returns)[1]:colnames(asset_returns)[nasset], key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset, Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Tangency Portfolio Weights") +
  scale_y_continuous(labels = scales::percent) 
ggplotly(p2)
#convert daily return, risk, SR to annualized ones

portfolio_values1_annual <- portfolio_values1 %>% mutate(Return = Return * 252) %>% mutate(Risk1 = Risk1 * sqrt(252), Risk2 = Risk2 * sqrt(252), Risk3 = Risk3 * sqrt(252), Risk4 = Risk4 * sqrt(252), Risk5 = Risk5 * sqrt(252)) %>% mutate(SharpeRatio1 = SharpeRatio1 * sqrt(252), SharpeRatio2 = SharpeRatio2 * sqrt(252), SharpeRatio3 = SharpeRatio3 * sqrt(252), SharpeRatio4 = SharpeRatio4 * sqrt(252), SharpeRatio5 = SharpeRatio5 * sqrt(252))
min_var1.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk1),]
min_var2.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk2),]
min_var3.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk3),]
min_var4.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk4),]
min_mad.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk5),]
max_sr1.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio1),]
max_sr2.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio2),]
max_sr3.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio3),]
max_sr4.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio4),]
max_sr5.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio5),]

rbind(min_var1.a, min_var2.a, min_var3.a, min_var4.a, min_mad.a, max_sr1.a, max_sr2.a, max_sr3.a, max_sr4.a, max_sr5.a)
## # A tibble: 10 × 18
##      AMZN   GOOGL     KO     PEP      PG    UPS     WMT Return Risk1 Risk2 Risk3
##     <dbl>   <dbl>  <dbl>   <dbl>   <dbl>  <dbl>   <dbl>  <dbl> <dbl> <dbl> <dbl>
##  1 0.278  0.0103  0.239  0.0367  0.0953  0.0620 0.279    0.360 0.301 0.120 0.234
##  2 0.0896 0.00494 0.468  0.00324 0.0937  0.137  0.204    0.227 0.312 0.112 0.238
##  3 0.359  0.0111  0.130  0.0305  0.00454 0.111  0.353    0.455 0.305 0.126 0.230
##  4 0.118  0.0488  0.421  0.0210  0.0639  0.323  0.00418  0.303 0.334 0.112 0.247
##  5 0.164  0.00889 0.207  0.0224  0.331   0.0214 0.246    0.296 0.308 0.119 0.245
##  6 0.579  0.0443  0.0692 0.0208  0.0524  0.126  0.108    0.574 0.332 0.126 0.238
##  7 0.579  0.0443  0.0692 0.0208  0.0524  0.126  0.108    0.574 0.332 0.126 0.238
##  8 0.579  0.0443  0.0692 0.0208  0.0524  0.126  0.108    0.574 0.332 0.126 0.238
##  9 0.579  0.0443  0.0692 0.0208  0.0524  0.126  0.108    0.574 0.332 0.126 0.238
## 10 0.396  0.0119  0.0197 0.0849  0.0981  0.382  0.00717  0.575 0.341 0.135 0.254
## # ℹ 7 more variables: Risk4 <dbl>, Risk5 <dbl>, SharpeRatio1 <dbl>,
## #   SharpeRatio2 <dbl>, SharpeRatio3 <dbl>, SharpeRatio4 <dbl>,
## #   SharpeRatio5 <dbl>
p1 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk1, y = Return, color = SharpeRatio1)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (SD)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk1,
                 y = Return), data = min_var1.a, color = 'orange') +
  geom_point(aes(x = Risk1,
                 y = Return), data = max_sr1.a, color = 'orange4', shape = 18)
ggplotly(p1)
p2 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk2, y = Return, color = SharpeRatio2)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (VEV)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk2,
                 y = Return), data = min_var2.a, color = 'green') +
  geom_point(aes(x = Risk2,
                 y = Return), data = max_sr2.a, color = 'green4', shape = 18)
ggplotly(p2)
p3 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk3, y = Return, color = SharpeRatio3)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (VES)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk3,
                 y = Return), data = min_var3.a, color = 'red') +
  geom_point(aes(x = Risk3,
                 y = Return), data = max_sr3.a, color = 'red4', shape = 18)
ggplotly(p3)
p4 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk4, y = Return, color = SharpeRatio4)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (VESV)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk4,
                 y = Return), data = min_var4.a, color = 'purple') +
  geom_point(aes(x = Risk4,
                 y = Return), data = max_sr4.a, color = 'purple4', shape = 18)
ggplotly(p4)
p5 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk5, y = Return, color = SharpeRatio5)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (MAD)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk5,
                 y = Return), data = min_mad.a, color = 'blue') +
  geom_point(aes(x = Risk5,
                 y = Return), data = max_sr5.a, color = 'blue4', shape = 18)
ggplotly(p5)

Plots cummulative returns of the test sample

MVP1 <- as.matrix(test)%*%as.vector(as.numeric(min_var1[1:nasset]))
MVP2 <- as.matrix(test)%*%as.vector(as.numeric(min_var2[1:nasset]))
MVP3 <- as.matrix(test)%*%as.vector(as.numeric(min_var3[1:nasset]))
MVP4 <- as.matrix(test)%*%as.vector(as.numeric(min_var4[1:nasset]))
MVP5 <- as.matrix(test)%*%as.vector(as.numeric(min_mad[1:nasset]))
TP1<-as.matrix(test)%*%as.vector(as.numeric(max_sr1[1:nasset]))
TP2<-as.matrix(test)%*%as.vector(as.numeric(max_sr2[1:nasset]))
TP3<-as.matrix(test)%*%as.vector(as.numeric(max_sr3[1:nasset]))
TP4<-as.matrix(test)%*%as.vector(as.numeric(max_sr4[1:nasset]))
TP5<-as.matrix(test)%*%as.vector(as.numeric(max_sr5[1:nasset]))
EWQ<-as.matrix(test)%*%as.vector(rep(1/nasset, nasset))
assets <- c("MVP1", "MVP2", "MVP3", "MVP4", "MVP5", "TP1", "TP2", "TP3", "TP4", "TP5", "EWQ")

#Portfolios <- merge(test[, 1], cumsum(MVP1), cumsum(MVP2), cumsum(MVP3), cumsum(MVP4), cumsum(MVP5), cumsum(TP1), cumsum(TP2), cumsum(TP3), cumsum(TP4), cumsum(TP5), cumsum(EWQ))[, -c(1)]

Portfolios <- cbind.data.frame(cumsum(MVP1), cumsum(MVP2), cumsum(MVP3), cumsum(MVP4), cumsum(MVP5), cumsum(TP1), cumsum(TP2), cumsum(TP3), cumsum(TP4), cumsum(TP5), cumsum(EWQ))

colnames(Portfolios) <- assets
# Define start and end dates
start_date <- as.Date("2020-01-01")
end_date <- as.Date("2020-12-31")
# Create a sequence of dates
date_sequence <- seq(start_date, end_date, by = "day")
#date_sequence

# Number of last values to select
nTemp <- nrow(Portfolios)

# Select the last 'n' values from the vector
TestDates <- date_sequence[(length(date_sequence) - nTemp + 1):length(date_sequence)]
#TestDates
row.names(Portfolios) <- TestDates
dygraph(Portfolios, main = 'Cummulative Returns for Test Period')%>%
dySeries('MVP1', label = 'MVP', col = "orange") %>%
dySeries('MVP2', label = 'MRP2', col = "green") %>%
dySeries('MVP3', label = 'MRP3', col = "red") %>%  
dySeries('MVP4', label = 'MRP4', col = "purple") %>%
dySeries('MVP5', label = 'MRP5', col = "blue") %>%
dySeries('TP1', label = 'TP', col = "orange", drawPoints = TRUE) %>% 
dySeries('TP2', label = 'MRRP2', col = "green", drawPoints = TRUE) %>%
dySeries('TP3', label = 'MRRP3', col = "red", drawPoints = TRUE) %>%  
dySeries('TP4', label = 'MRRP4', col = "purple", drawPoints = TRUE) %>% 
dySeries('TP5', label = 'MRRP5', col = "blue", drawPoints = TRUE) %>%  
dySeries('EWQ', label = 'EWQ', col = "black") %>% 
dyRangeSelector(height = 30)%>%
  dyLegend(width = 500)

Choose cummulative return from volatility correlations - empcor network portfolio

CumReturnVolCorr_low_risk <- cumsum(TP2)
CumReturnVolCorr_low_risk
##  [1]  0.0177295323 -0.0028038284  0.0212085082  0.0225522100  0.0432723750
##  [6]  0.0763538343  0.0760906238  0.0598254852  0.0550685735  0.0447099331
## [11]  0.0272790002  0.0335089146  0.0274703867  0.0266335538  0.0320144842
## [16]  0.0254311375  0.0435175002  0.0008922063  0.0155203747 -0.0187774122
## [21] -0.0197152903 -0.0033688552  0.0342819129  0.0521136010  0.0554776380
## [26]  0.0236591580  0.0089376329  0.0324542020  0.0248893615  0.0326924136
## [31]  0.0381889661  0.0363854081  0.0273053457  0.0312536700  0.0233538521
## [36]  0.0253746879  0.0355851618  0.0465535887  0.0473783361  0.0432309085
## [41]  0.0524235485  0.0488354604  0.0447260490  0.0413204076  0.0388096519
## [46]  0.0427836890  0.0295012128  0.0237003443  0.0306511140  0.0348320888
## [51]  0.0380407660  0.0531895382  0.0563914226  0.0513387118  0.0485366095
## [56]  0.0477250756  0.0423680309  0.0412098371  0.0647857406  0.0686239355
## [61]  0.0597372223

Portfolio selected from DD_DBSCAN_2020_highest_mean

DD_DBSCAN_2020_highest_mean <- read.csv("DD_DBSCAN_2020_highest_mean.csv")

#remove the date column
asset_prices<-DD_DBSCAN_2020_highest_mean[,-1]
# calculate returns
ret_tidy1 = apply(asset_prices,2, log)
head(ret_tidy1)
##          AAPL     AMZN      CAT    GOOGL     MSFT     TSLA      UPS
## [1,] 4.288761 4.552829 4.907983 4.223397 5.036551 3.356339 4.599936
## [2,] 4.278992 4.540616 4.894001 4.218152 5.024021 3.385542 4.599337
## [3,] 4.286928 4.555392 4.893327 4.244457 5.026603 3.404614 4.594872
## [4,] 4.282214 4.557481 4.880026 4.242523 5.017443 3.442680 4.593149
## [5,] 4.298172 4.549642 4.888868 4.249616 5.033246 3.490713 4.598823
## [6,] 4.319190 4.554429 4.886360 4.260059 5.045662 3.468524 4.601135
ret_tidy2 = diff(ret_tidy1)
head(ret_tidy2)
##              AAPL         AMZN           CAT        GOOGL         MSFT
## [1,] -0.009769385 -0.012213314 -0.0139816410 -0.005245064 -0.012529783
## [2,]  0.007936156  0.014775871 -0.0006740815  0.026305039  0.002581361
## [3,] -0.004713898  0.002089436 -0.0133009727 -0.001933350 -0.009159491
## [4,]  0.015957985 -0.007839287  0.0088419810  0.007092451  0.015802856
## [5,]  0.021018571  0.004787695 -0.0025088345  0.010443219  0.012415835
## [6,]  0.002258306 -0.009455156 -0.0080423128  0.006437819 -0.004637966
##              TSLA           UPS
## [1,]  0.029202679 -0.0005993921
## [2,]  0.019071612 -0.0044651876
## [3,]  0.038066706 -0.0017224533
## [4,]  0.048032568  0.0056735024
## [5,] -0.022189385  0.0023116211
## [6,] -0.006649356 -0.0091064735
ret_tidy = exp (ret_tidy2) - 1 #simple returns
#remove first row
asset_returns <- ret_tidy[-1,]

#no.of assets in the portfolio 
nasset<-ncol(asset_returns)

# testing and training data sets (each data set has 252 observations)
# Divide the data set in to 3:1 (75% training and 25% testing)
# testing period - January - September (189 data points)
# training period - October - December (62 data points)

n.total<-252
n.train<- 189

train = asset_returns[1:n.train,]
test = asset_returns[-(1:(n.train)),]
##summary statistics 
rhosign<-apply(as.matrix(train), MARGIN=2, FUN=rho.cal)
rhovol<-apply(as.matrix(train), MARGIN=2, FUN=rho.vol)
assetsummary<-data.frame(apply(train, 2, mean), apply(train, 2, sd), rhovol, rhosign, apply(train, 2, skewness),
                 apply(train, 2, kurtosis))
xtable(assetsummary, digits=4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:21 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrr}
##   \hline
##  & apply.train..2..mean. & apply.train..2..sd. & rhovol & rhosign & apply.train..2..skewness. & apply.train..2..kurtosis. \\ 
##   \hline
## AAPL & 0.0028 & 0.0317 & 0.9287 & 0.6937 & -0.0759 & 3.3262 \\ 
##   AMZN & 0.0030 & 0.0253 & 0.9367 & 0.7448 & 0.0705 & 1.0722 \\ 
##   CAT & 0.0006 & 0.0304 & 0.8989 & 0.7157 & -0.5070 & 3.0716 \\ 
##   GOOGL & 0.0007 & 0.0261 & 0.9148 & 0.6923 & -0.2472 & 3.4690 \\ 
##   MSFT & 0.0019 & 0.0306 & 0.9042 & 0.6814 & -0.0716 & 5.2156 \\ 
##   TSLA & 0.0101 & 0.0619 & 0.9346 & 0.7226 & -0.1939 & 1.6724 \\ 
##   UPS & 0.0024 & 0.0279 & 0.8975 & 0.6523 & 0.9737 & 4.8973 \\ 
##    \hline
## \end{tabular}
## \end{table}
plot(train, legend.loc=1)
## Warning in plot.window(...): "legend.loc" is not a graphical parameter
## Warning in plot.xy(xy, type, ...): "legend.loc" is not a graphical parameter
## Warning in axis(side = side, at = at, labels = labels, ...): "legend.loc" is
## not a graphical parameter

## Warning in axis(side = side, at = at, labels = labels, ...): "legend.loc" is
## not a graphical parameter
## Warning in box(...): "legend.loc" is not a graphical parameter
## Warning in title(...): "legend.loc" is not a graphical parameter

Lets calculate annualized portfolio return, risk, and gamma from the simulated portfolio returns with portfolio weights. (simulated weights)

## portfolio return, sd and gamma
## w is the random weight
## data = train or test
portfolio_info = function(w, data){
  port.data <- data%*%as.vector(w)
  port.cdf <- ecdf(port.data)
  port.return <- mean (port.data)
  port.sd <- sd (port.data)
  port.signrho <- cor (port.data - port.return, sign(port.data - port.return))
# port.signrho3 <- cor (sign(port.data - port.return), (port.data - port.return)^3)
# port.skewrho <- cor (port.data - port.return, (port.data - port.return)^2)
  port.volcor <- cor (abs(port.data - port.return), (port.data - port.return)^2) #volatlity correlation
  port.skewness <- skewness (port.data) #mu_3/sigma^3
  port.kurtosis <- kurtosis (port.data) #excess kurtosis mu_4/sigma^4 - 3
  return(c(port.return, port.sd, port.volcor, port.signrho, port.cdf(port.return), port.skewness, port.kurtosis))
}
# In stat matrix and weight matrix nrow = no.of assets in the portfolio (need to change), ncol is fixed to 7 , for loop i in 1:nrow
stat<-matrix(0, nrow = nasset, ncol = 7)
weight<-matrix(0, nrow = nasset, ncol = nasset)
for (i in 1:nasset){
weight[i, ] <- get_weights(nasset)
stat[i, ] <- portfolio_info (weight[i, ], as.matrix(train))
}
xtable(weight, digits = 4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:21 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 & 6 & 7 \\ 
##   \hline
## 1 & 0.2710 & 0.0987 & 0.2803 & 0.0370 & 0.0016 & 0.1430 & 0.1684 \\ 
##   2 & 0.0454 & 0.2618 & 0.1698 & 0.1181 & 0.0514 & 0.1078 & 0.2456 \\ 
##   3 & 0.1012 & 0.1752 & 0.1973 & 0.0708 & 0.2059 & 0.1743 & 0.0754 \\ 
##   4 & 0.2267 & 0.2055 & 0.0500 & 0.1996 & 0.1480 & 0.0138 & 0.1564 \\ 
##   5 & 0.0176 & 0.1763 & 0.2979 & 0.1348 & 0.2062 & 0.0977 & 0.0694 \\ 
##   6 & 0.0228 & 0.1957 & 0.1681 & 0.1909 & 0.1126 & 0.1398 & 0.1703 \\ 
##   7 & 0.1952 & 0.1834 & 0.1200 & 0.0253 & 0.1052 & 0.2575 & 0.1132 \\ 
##    \hline
## \end{tabular}
## \end{table}
xtable(stat, digits = 4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:21 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 & 6 & 7 \\ 
##   \hline
## 1 & 0.0031 & 0.0261 & 0.9212 & 0.6919 & 0.4444 & -0.7137 & 3.1677 \\ 
##   2 & 0.0029 & 0.0238 & 0.9283 & 0.6915 & 0.4550 & -0.6351 & 2.6472 \\ 
##   3 & 0.0033 & 0.0271 & 0.9203 & 0.6958 & 0.4392 & -0.7561 & 3.0006 \\ 
##   4 & 0.0022 & 0.0245 & 0.9240 & 0.6866 & 0.4444 & -0.3466 & 3.4473 \\ 
##   5 & 0.0024 & 0.0251 & 0.9268 & 0.6930 & 0.4286 & -0.6481 & 3.3528 \\ 
##   6 & 0.0029 & 0.0250 & 0.9221 & 0.6982 & 0.4233 & -0.7262 & 2.8420 \\ 
##   7 & 0.0043 & 0.0294 & 0.9189 & 0.7003 & 0.4815 & -0.7669 & 2.4987 \\ 
##    \hline
## \end{tabular}
## \end{table}

Check for the portfolio sd can be calcualted by both the formula and sd of the simulated portfolio.

We have everything we need to perform our optimization. All we need now is to run this code on 8000 random portfolios. For that we will use a for loop.

Before we do that, we need to create empty vectors and matrix for storing our values.

#change nasset to no of assets in portfolio
num_port <- 10000
nasset <- nasset

# Creating a matrix to store the weights

all_wts1 <- matrix(nrow = num_port,
                  ncol = nasset)

# Creating an empty vector to store
# 8000 Portfolio returns

port_returns <- vector('numeric', length = num_port)

# Creating an empty vector to store
# 8000 Portfolio variances

port_risk.var1 <- vector('numeric', length = num_port)
port_risk.var2 <- vector('numeric', length = num_port)
port_risk.var3 <- vector('numeric', length = num_port)
port_risk.var4 <- vector('numeric', length = num_port)
port_risk.mad <- vector('numeric', length = num_port)

Sharpe_ratio.sd1 <- vector('numeric', length = num_port)
Sharpe_ratio.sd2 <- vector('numeric', length = num_port)
Sharpe_ratio.sd3 <- vector('numeric', length = num_port)
Sharpe_ratio.sd4 <- vector('numeric', length = num_port)
Sharpe_ratio.mad <- vector('numeric', length = num_port)

Next lets run the for loop 10000 times.

port.info <- matrix(0, nrow = 10000, ncol = 7)

ptm <- proc.time()

for (i in seq_along(port_returns)) {
  
  wts <- get_weights(nasset)
  
  # Storing weight in the matrix
  all_wts1[i,] <- wts
  
  # Portfolio returns
  
  port.info [i, ]<- portfolio_info (wts, as.matrix(train))
  
  # Storing Portfolio Returns values
  port_returns[i] <- port.info[i, 1]
  
  # Creating and storing portfolio risk
  port_risk.var1 [i] <- port.info[i, 2]
  port_risk.var2 [i] <- sqrt(1 - port.info[i, 3]^2)*port.info[i, 2]
  port_risk.var3 [i] <- sqrt(1 - port.info[i, 4]^2)*port.info[i, 2]
  port_risk.var4 [i] <- sqrt(1 - port.info[i, 3]^2)*sqrt(1 - port.info[i, 4]^2)*port.info[i, 2]
  port_risk.mad [i] <- 2*port.info[i, 2]*port.info[i, 4]*sqrt(port.info[i, 5]*(1-port.info[i, 5]))
  
  # Creating and storing Portfolio Sharpe Ratios
  # Assuming 0% Risk free rate
  
  Sharpe_ratio.sd1 [i] <- port_returns[i]/port_risk.var1 [i]
  Sharpe_ratio.sd2 [i] <- port_returns[i]/port_risk.var2 [i]
  Sharpe_ratio.sd3 [i] <- port_returns[i]/port_risk.var3 [i]
  Sharpe_ratio.sd4 [i] <- port_returns[i]/port_risk.var4 [i]
  Sharpe_ratio.mad [i] <- port_returns[i]/port_risk.mad [i]
}
proc.time()-ptm
##    user  system elapsed 
##    1.56    0.01    4.28
port.info.data <- as.data.frame(port.info)

ggplot(port.info.data, aes(x=V6, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Skewness") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V7, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Kurtosis") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V6)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Skewness")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V7)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Kurtosis")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V2)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Volatility")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V2, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V3, y=V2)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Volatlity Correlation") + ylab ("Volatlity")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V2)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Volatility")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V6)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Skewness")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V7)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Kurtosis")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

ggplot(port.info.data, aes(x=V4, y=V1)) + geom_point(color="blue", alpha=0.5) +geom_smooth(color="darkred") + xlab ("Sign Correlation") + ylab ("Return")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

We now create a data table to store all the values together (using sd).

# Storing the values in the table (5 columns and 8000 rows)
portfolio_values1 <- tibble(Return = port_returns,
                  Risk1 = port_risk.var1,
                  Risk2 = port_risk.var2,
                  Risk3 = port_risk.var3,
                  Risk4 = port_risk.var4,
                  Risk5 = port_risk.mad,
                  SharpeRatio1 = Sharpe_ratio.sd1,
                  SharpeRatio2 = Sharpe_ratio.sd2,
                  SharpeRatio3 = Sharpe_ratio.sd3,
                  SharpeRatio4 = Sharpe_ratio.sd4,
                  SharpeRatio5 = Sharpe_ratio.mad,
                  )
# Converting matrix to a tibble and changing column names
all_wts1 <- tk_tbl(all_wts1)
## Warning in tk_tbl.data.frame(as.data.frame(data), preserve_index, rename_index,
## : Warning: No index to preserve. Object otherwise converted to tibble
## successfully.
colnames(all_wts1) <- colnames(asset_returns)

# Combing all the values together
portfolio_values1 <- tk_tbl(cbind(all_wts1, portfolio_values1))
## Warning in tk_tbl.data.frame(cbind(all_wts1, portfolio_values1)): Warning: No
## index to preserve. Object otherwise converted to tibble successfully.

We have the weights in each asset with the risk and returns along with the Sharpe ratio of each portfolio. We use daily data to determine the portfolios.

Next lets look at the portfolios that matter the most.

min_var1 <- portfolio_values1[which.min(portfolio_values1$Risk1),]
min_var2 <- portfolio_values1[which.min(portfolio_values1$Risk2),]
min_var3 <- portfolio_values1[which.min(portfolio_values1$Risk3),]
min_var4 <- portfolio_values1[which.min(portfolio_values1$Risk4),]
min_mad <- portfolio_values1[which.min(portfolio_values1$Risk5),]
max_sr1 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio1),]
max_sr2 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio2),]
max_sr3 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio3),]
max_sr4 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio4),]
max_sr5 <- portfolio_values1[which.max(portfolio_values1$SharpeRatio5),]
rbind(min_var1, min_var2, min_var3, min_var4, min_mad, max_sr1, max_sr2, max_sr3, max_sr4, max_sr5)
## # A tibble: 10 × 18
##       AAPL    AMZN   CAT   GOOGL   MSFT    TSLA    UPS  Return  Risk1   Risk2
##      <dbl>   <dbl> <dbl>   <dbl>  <dbl>   <dbl>  <dbl>   <dbl>  <dbl>   <dbl>
##  1 0.0161  0.340   0.205 0.114   0.0503 0.00425 0.271  0.00208 0.0222 0.00826
##  2 0.00156 0.256   0.124 0.290   0.0197 0.00689 0.302  0.00190 0.0224 0.00818
##  3 0.0898  0.383   0.195 0.0259  0.0197 0.00948 0.277  0.00235 0.0224 0.00829
##  4 0.0511  0.545   0.134 0.132   0.0277 0.0328  0.0778 0.00254 0.0231 0.00828
##  5 0.0161  0.340   0.205 0.114   0.0503 0.00425 0.271  0.00208 0.0222 0.00826
##  6 0.0212  0.116   0.102 0.00882 0.0106 0.409   0.332  0.00544 0.0326 0.0124 
##  7 0.0600  0.00824 0.114 0.00630 0.0172 0.538   0.256  0.00637 0.0385 0.0141 
##  8 0.0212  0.116   0.102 0.00882 0.0106 0.409   0.332  0.00544 0.0326 0.0124 
##  9 0.0600  0.00824 0.114 0.00630 0.0172 0.538   0.256  0.00637 0.0385 0.0141 
## 10 0.0212  0.116   0.102 0.00882 0.0106 0.409   0.332  0.00544 0.0326 0.0124 
## # ℹ 8 more variables: Risk3 <dbl>, Risk4 <dbl>, Risk5 <dbl>,
## #   SharpeRatio1 <dbl>, SharpeRatio2 <dbl>, SharpeRatio3 <dbl>,
## #   SharpeRatio4 <dbl>, SharpeRatio5 <dbl>
xtable(rbind(min_var1, min_var2, min_var3, min_var4, min_mad, max_sr1, max_sr2, max_sr3, max_sr4, max_sr5), digits = 6)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:38 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrrrrrrrrrrrrrr}
##   \hline
##  & AAPL & AMZN & CAT & GOOGL & MSFT & TSLA & UPS & Return & Risk1 & Risk2 & Risk3 & Risk4 & Risk5 & SharpeRatio1 & SharpeRatio2 & SharpeRatio3 & SharpeRatio4 & SharpeRatio5 \\ 
##   \hline
## 1 & 0.016138 & 0.339601 & 0.204939 & 0.114085 & 0.050287 & 0.004252 & 0.270699 & 0.002076 & 0.022226 & 0.008265 & 0.016248 & 0.006042 & 0.015118 & 0.093389 & 0.251137 & 0.127749 & 0.343539 & 0.137297 \\ 
##   2 & 0.001560 & 0.255590 & 0.123533 & 0.290445 & 0.019718 & 0.006893 & 0.302260 & 0.001897 & 0.022374 & 0.008181 & 0.016336 & 0.005973 & 0.015241 & 0.084769 & 0.231822 & 0.116104 & 0.317515 & 0.124445 \\ 
##   3 & 0.089848 & 0.382824 & 0.195373 & 0.025864 & 0.019669 & 0.009482 & 0.276941 & 0.002352 & 0.022372 & 0.008292 & 0.016189 & 0.006000 & 0.015327 & 0.105124 & 0.283623 & 0.145278 & 0.391958 & 0.153447 \\ 
##   4 & 0.051150 & 0.544724 & 0.133979 & 0.131909 & 0.027720 & 0.032756 & 0.077762 & 0.002539 & 0.023051 & 0.008276 & 0.016224 & 0.005825 & 0.016308 & 0.110134 & 0.306741 & 0.156477 & 0.435811 & 0.155672 \\ 
##   5 & 0.016138 & 0.339601 & 0.204939 & 0.114085 & 0.050287 & 0.004252 & 0.270699 & 0.002076 & 0.022226 & 0.008265 & 0.016248 & 0.006042 & 0.015118 & 0.093389 & 0.251137 & 0.127749 & 0.343539 & 0.137297 \\ 
##   6 & 0.021200 & 0.116149 & 0.102062 & 0.008820 & 0.010601 & 0.408748 & 0.332421 & 0.005443 & 0.032581 & 0.012359 & 0.022389 & 0.008493 & 0.023642 & 0.167065 & 0.440406 & 0.243115 & 0.640886 & 0.230225 \\ 
##   7 & 0.059977 & 0.008239 & 0.114004 & 0.006302 & 0.017230 & 0.538131 & 0.256118 & 0.006367 & 0.038481 & 0.014059 & 0.026543 & 0.009697 & 0.027852 & 0.165465 & 0.452902 & 0.239886 & 0.656604 & 0.228612 \\ 
##   8 & 0.021200 & 0.116149 & 0.102062 & 0.008820 & 0.010601 & 0.408748 & 0.332421 & 0.005443 & 0.032581 & 0.012359 & 0.022389 & 0.008493 & 0.023642 & 0.167065 & 0.440406 & 0.243115 & 0.640886 & 0.230225 \\ 
##   9 & 0.059977 & 0.008239 & 0.114004 & 0.006302 & 0.017230 & 0.538131 & 0.256118 & 0.006367 & 0.038481 & 0.014059 & 0.026543 & 0.009697 & 0.027852 & 0.165465 & 0.452902 & 0.239886 & 0.656604 & 0.228612 \\ 
##   10 & 0.021200 & 0.116149 & 0.102062 & 0.008820 & 0.010601 & 0.408748 & 0.332421 & 0.005443 & 0.032581 & 0.012359 & 0.022389 & 0.008493 & 0.023642 & 0.167065 & 0.440406 & 0.243115 & 0.640886 & 0.230225 \\ 
##    \hline
## \end{tabular}
## \end{table}
# change min_var1[1:nassets] and all the indexes after that accordingly
p1 <- cbind(min_var1[1:nasset], 252*min_var1[nasset+1], sqrt(252)*min_var1[nasset+2], sqrt(252)*min_var1[nasset+7])
p2 <- cbind(min_var2[1:nasset], 252*min_var2[nasset+1], sqrt(252)*min_var2[nasset+3], sqrt(252)*min_var2[nasset+8])
p3 <- cbind(min_var3[1:nasset], 252*min_var3[nasset+1], sqrt(252)*min_var3[nasset+4], sqrt(252)*min_var3[nasset+9])
p4 <- cbind(min_var4[1:nasset], 252*min_var4[nasset+1], sqrt(252)*min_var4[nasset+5], sqrt(252)*min_var4[nasset+10])
p5 <- cbind(min_mad[1:nasset], 252*min_mad[nasset+1], sqrt(252)*min_mad[nasset+6], sqrt(252)*min_mad[nasset+11])
xtable(t(rbind(as.numeric(p1), as.numeric(p2), as.numeric(p3), as.numeric(p4), as.numeric(p5))), digits = 5)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:38 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 \\ 
##   \hline
## 1 & 0.01614 & 0.00156 & 0.08985 & 0.05115 & 0.01614 \\ 
##   2 & 0.33960 & 0.25559 & 0.38282 & 0.54472 & 0.33960 \\ 
##   3 & 0.20494 & 0.12353 & 0.19537 & 0.13398 & 0.20494 \\ 
##   4 & 0.11408 & 0.29044 & 0.02586 & 0.13191 & 0.11408 \\ 
##   5 & 0.05029 & 0.01972 & 0.01967 & 0.02772 & 0.05029 \\ 
##   6 & 0.00425 & 0.00689 & 0.00948 & 0.03276 & 0.00425 \\ 
##   7 & 0.27070 & 0.30226 & 0.27694 & 0.07776 & 0.27070 \\ 
##   8 & 0.52306 & 0.47795 & 0.59266 & 0.63974 & 0.52306 \\ 
##   9 & 0.35282 & 0.12988 & 0.25699 & 0.09247 & 0.23999 \\ 
##   10 & 1.48250 & 3.68006 & 2.30622 & 6.91829 & 2.17953 \\ 
##    \hline
## \end{tabular}
## \end{table}
# change max_sr[1:nassets] and all the indexes after that accordingly
p1 <- cbind(max_sr1[1:nasset], 252*max_sr1[nasset+1], sqrt(252)*max_sr1[nasset+2], sqrt(252)*max_sr1[nasset+7])
p2 <- cbind(max_sr2[1:nasset], 252*max_sr2[nasset+1], sqrt(252)*max_sr2[nasset+3], sqrt(252)*max_sr2[nasset+8])
p3 <- cbind(max_sr3[1:nasset], 252*max_sr3[nasset+1], sqrt(252)*max_sr3[nasset+4], sqrt(252)*max_sr3[nasset+9])
p4 <- cbind(max_sr4[1:nasset], 252*max_sr4[nasset+1], sqrt(252)*max_sr4[nasset+5], sqrt(252)*max_sr4[nasset+10])
p5 <- cbind(max_sr5[1:nasset], 252*max_sr5[nasset+1], sqrt(252)*max_sr5[nasset+6], sqrt(252)*max_sr5[nasset+11])
xtable(t(rbind(as.numeric(p1), as.numeric(p2), as.numeric(p3), as.numeric(p4), as.numeric(p5))), digits = 5)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:38 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrr}
##   \hline
##  & 1 & 2 & 3 & 4 & 5 \\ 
##   \hline
## 1 & 0.02120 & 0.05998 & 0.02120 & 0.05998 & 0.02120 \\ 
##   2 & 0.11615 & 0.00824 & 0.11615 & 0.00824 & 0.11615 \\ 
##   3 & 0.10206 & 0.11400 & 0.10206 & 0.11400 & 0.10206 \\ 
##   4 & 0.00882 & 0.00630 & 0.00882 & 0.00630 & 0.00882 \\ 
##   5 & 0.01060 & 0.01723 & 0.01060 & 0.01723 & 0.01060 \\ 
##   6 & 0.40875 & 0.53813 & 0.40875 & 0.53813 & 0.40875 \\ 
##   7 & 0.33242 & 0.25612 & 0.33242 & 0.25612 & 0.33242 \\ 
##   8 & 1.37166 & 1.60456 & 1.37166 & 1.60456 & 1.37166 \\ 
##   9 & 0.51720 & 0.22318 & 0.35541 & 0.15394 & 0.37531 \\ 
##   10 & 2.65207 & 7.18959 & 3.85933 & 10.42326 & 3.65470 \\ 
##    \hline
## \end{tabular}
## \end{table}
nasset <- ncol(asset_returns)
w1 <- min_var1[, 1:nasset] %>% gather () %>% arrange(desc(value))
w2 <- min_var2[, 1:nasset] %>% gather () %>% arrange(desc(value))
w3 <- min_var3[, 1:nasset] %>% gather () %>% arrange(desc(value))
w4 <- min_var4[, 1:nasset] %>% gather () %>% arrange(desc(value))
w5 <- min_mad[, 1:nasset] %>% gather () %>% arrange(desc(value))
w6 <- max_sr1[, 1:nasset] %>% gather () %>% arrange(desc(value))
w7 <- max_sr2[, 1:nasset] %>% gather () %>% arrange(desc(value))
w8 <- max_sr3[, 1:nasset] %>% gather () %>% arrange(desc(value))
w9 <- max_sr4[, 1:nasset] %>% gather () %>% arrange(desc(value))
w10 <- max_sr5[, 1:nasset] %>% gather () %>% arrange(desc(value))

xtable(cbind(head (w1, 10), head (w2, 10), head (w3, 10), head (w4, 10), head (w5, 10), head (w6, 10), head (w7, 10), head (w8, 10), head (w9, 10), head (w10, 10)), digits = 4)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Sep 27 14:43:38 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrlrlrlrlrlrlrlrlrlr}
##   \hline
##  & key & value & key & value & key & value & key & value & key & value & key & value & key & value & key & value & key & value & key & value \\ 
##   \hline
## 1 & AMZN & 0.3396 & UPS & 0.3023 & AMZN & 0.3828 & AMZN & 0.5447 & AMZN & 0.3396 & TSLA & 0.4087 & TSLA & 0.5381 & TSLA & 0.4087 & TSLA & 0.5381 & TSLA & 0.4087 \\ 
##   2 & UPS & 0.2707 & GOOGL & 0.2904 & UPS & 0.2769 & CAT & 0.1340 & UPS & 0.2707 & UPS & 0.3324 & UPS & 0.2561 & UPS & 0.3324 & UPS & 0.2561 & UPS & 0.3324 \\ 
##   3 & CAT & 0.2049 & AMZN & 0.2556 & CAT & 0.1954 & GOOGL & 0.1319 & CAT & 0.2049 & AMZN & 0.1161 & CAT & 0.1140 & AMZN & 0.1161 & CAT & 0.1140 & AMZN & 0.1161 \\ 
##   4 & GOOGL & 0.1141 & CAT & 0.1235 & AAPL & 0.0898 & UPS & 0.0778 & GOOGL & 0.1141 & CAT & 0.1021 & AAPL & 0.0600 & CAT & 0.1021 & AAPL & 0.0600 & CAT & 0.1021 \\ 
##   5 & MSFT & 0.0503 & MSFT & 0.0197 & GOOGL & 0.0259 & AAPL & 0.0511 & MSFT & 0.0503 & AAPL & 0.0212 & MSFT & 0.0172 & AAPL & 0.0212 & MSFT & 0.0172 & AAPL & 0.0212 \\ 
##   6 & AAPL & 0.0161 & TSLA & 0.0069 & MSFT & 0.0197 & TSLA & 0.0328 & AAPL & 0.0161 & MSFT & 0.0106 & AMZN & 0.0082 & MSFT & 0.0106 & AMZN & 0.0082 & MSFT & 0.0106 \\ 
##   7 & TSLA & 0.0043 & AAPL & 0.0016 & TSLA & 0.0095 & MSFT & 0.0277 & TSLA & 0.0043 & GOOGL & 0.0088 & GOOGL & 0.0063 & GOOGL & 0.0088 & GOOGL & 0.0063 & GOOGL & 0.0088 \\ 
##    \hline
## \end{tabular}
## \end{table}

Lets plot the weights of each portfolio. First with the minimum variance portfolio.

p1 <- min_var4 %>%
  gather(colnames(asset_returns)[1]:colnames(asset_returns)[nasset], key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset,Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Minimum Risk Portfolio Weights") +
  scale_y_continuous(labels = scales::percent) 
ggplotly(p1)
p2 <- max_sr4 %>%
  gather(colnames(asset_returns)[1]:colnames(asset_returns)[nasset], key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset, Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Tangency Portfolio Weights") +
  scale_y_continuous(labels = scales::percent) 
ggplotly(p2)
#convert daily return, risk, SR to annualized ones

portfolio_values1_annual <- portfolio_values1 %>% mutate(Return = Return * 252) %>% mutate(Risk1 = Risk1 * sqrt(252), Risk2 = Risk2 * sqrt(252), Risk3 = Risk3 * sqrt(252), Risk4 = Risk4 * sqrt(252), Risk5 = Risk5 * sqrt(252)) %>% mutate(SharpeRatio1 = SharpeRatio1 * sqrt(252), SharpeRatio2 = SharpeRatio2 * sqrt(252), SharpeRatio3 = SharpeRatio3 * sqrt(252), SharpeRatio4 = SharpeRatio4 * sqrt(252), SharpeRatio5 = SharpeRatio5 * sqrt(252))
min_var1.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk1),]
min_var2.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk2),]
min_var3.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk3),]
min_var4.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk4),]
min_mad.a <- portfolio_values1_annual[which.min(portfolio_values1_annual$Risk5),]
max_sr1.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio1),]
max_sr2.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio2),]
max_sr3.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio3),]
max_sr4.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio4),]
max_sr5.a <- portfolio_values1_annual[which.max(portfolio_values1_annual$SharpeRatio5),]

rbind(min_var1.a, min_var2.a, min_var3.a, min_var4.a, min_mad.a, max_sr1.a, max_sr2.a, max_sr3.a, max_sr4.a, max_sr5.a)
## # A tibble: 10 × 18
##       AAPL    AMZN   CAT   GOOGL   MSFT    TSLA    UPS Return Risk1 Risk2 Risk3
##      <dbl>   <dbl> <dbl>   <dbl>  <dbl>   <dbl>  <dbl>  <dbl> <dbl> <dbl> <dbl>
##  1 0.0161  0.340   0.205 0.114   0.0503 0.00425 0.271   0.523 0.353 0.131 0.258
##  2 0.00156 0.256   0.124 0.290   0.0197 0.00689 0.302   0.478 0.355 0.130 0.259
##  3 0.0898  0.383   0.195 0.0259  0.0197 0.00948 0.277   0.593 0.355 0.132 0.257
##  4 0.0511  0.545   0.134 0.132   0.0277 0.0328  0.0778  0.640 0.366 0.131 0.258
##  5 0.0161  0.340   0.205 0.114   0.0503 0.00425 0.271   0.523 0.353 0.131 0.258
##  6 0.0212  0.116   0.102 0.00882 0.0106 0.409   0.332   1.37  0.517 0.196 0.355
##  7 0.0600  0.00824 0.114 0.00630 0.0172 0.538   0.256   1.60  0.611 0.223 0.421
##  8 0.0212  0.116   0.102 0.00882 0.0106 0.409   0.332   1.37  0.517 0.196 0.355
##  9 0.0600  0.00824 0.114 0.00630 0.0172 0.538   0.256   1.60  0.611 0.223 0.421
## 10 0.0212  0.116   0.102 0.00882 0.0106 0.409   0.332   1.37  0.517 0.196 0.355
## # ℹ 7 more variables: Risk4 <dbl>, Risk5 <dbl>, SharpeRatio1 <dbl>,
## #   SharpeRatio2 <dbl>, SharpeRatio3 <dbl>, SharpeRatio4 <dbl>,
## #   SharpeRatio5 <dbl>
p1 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk1, y = Return, color = SharpeRatio1)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (SD)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk1,
                 y = Return), data = min_var1.a, color = 'orange') +
  geom_point(aes(x = Risk1,
                 y = Return), data = max_sr1.a, color = 'orange4', shape = 18)
ggplotly(p1)
p2 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk2, y = Return, color = SharpeRatio2)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (VEV)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk2,
                 y = Return), data = min_var2.a, color = 'green') +
  geom_point(aes(x = Risk2,
                 y = Return), data = max_sr2.a, color = 'green4', shape = 18)
ggplotly(p2)
p3 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk3, y = Return, color = SharpeRatio3)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (VES)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk3,
                 y = Return), data = min_var3.a, color = 'red') +
  geom_point(aes(x = Risk3,
                 y = Return), data = max_sr3.a, color = 'red4', shape = 18)
ggplotly(p3)
p4 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk4, y = Return, color = SharpeRatio4)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (VESV)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk4,
                 y = Return), data = min_var4.a, color = 'purple') +
  geom_point(aes(x = Risk4,
                 y = Return), data = max_sr4.a, color = 'purple4', shape = 18)
ggplotly(p4)
p5 <- portfolio_values1_annual %>%
  ggplot(aes(x = Risk5, y = Return, color = SharpeRatio5)) +
  geom_point(alpha = 0.4)+
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk (MAD)',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk5,
                 y = Return), data = min_mad.a, color = 'blue') +
  geom_point(aes(x = Risk5,
                 y = Return), data = max_sr5.a, color = 'blue4', shape = 18)
ggplotly(p5)

Plots cummulative returns of the test sample

MVP1 <- as.matrix(test)%*%as.vector(as.numeric(min_var1[1:nasset]))
MVP2 <- as.matrix(test)%*%as.vector(as.numeric(min_var2[1:nasset]))
MVP3 <- as.matrix(test)%*%as.vector(as.numeric(min_var3[1:nasset]))
MVP4 <- as.matrix(test)%*%as.vector(as.numeric(min_var4[1:nasset]))
MVP5 <- as.matrix(test)%*%as.vector(as.numeric(min_mad[1:nasset]))
TP1<-as.matrix(test)%*%as.vector(as.numeric(max_sr1[1:nasset]))
TP2<-as.matrix(test)%*%as.vector(as.numeric(max_sr2[1:nasset]))
TP3<-as.matrix(test)%*%as.vector(as.numeric(max_sr3[1:nasset]))
TP4<-as.matrix(test)%*%as.vector(as.numeric(max_sr4[1:nasset]))
TP5<-as.matrix(test)%*%as.vector(as.numeric(max_sr5[1:nasset]))
EWQ<-as.matrix(test)%*%as.vector(rep(1/nasset, nasset))
assets <- c("MVP1", "MVP2", "MVP3", "MVP4", "MVP5", "TP1", "TP2", "TP3", "TP4", "TP5", "EWQ")

#Portfolios <- merge(test[, 1], cumsum(MVP1), cumsum(MVP2), cumsum(MVP3), cumsum(MVP4), cumsum(MVP5), cumsum(TP1), cumsum(TP2), cumsum(TP3), cumsum(TP4), cumsum(TP5), cumsum(EWQ))[, -c(1)]

Portfolios <- cbind.data.frame(cumsum(MVP1), cumsum(MVP2), cumsum(MVP3), cumsum(MVP4), cumsum(MVP5), cumsum(TP1), cumsum(TP2), cumsum(TP3), cumsum(TP4), cumsum(TP5), cumsum(EWQ))

colnames(Portfolios) <- assets
# Define start and end dates
start_date <- as.Date("2020-01-01")
end_date <- as.Date("2020-12-31")
# Create a sequence of dates
date_sequence <- seq(start_date, end_date, by = "day")
#date_sequence

# Number of last values to select
nTemp <- nrow(Portfolios)

# Select the last 'n' values from the vector
TestDates <- date_sequence[(length(date_sequence) - nTemp + 1):length(date_sequence)]
#TestDates
row.names(Portfolios) <- TestDates
dygraph(Portfolios, main = 'Cummulative Returns for Test Period')%>%
dySeries('MVP1', label = 'MVP', col = "orange") %>%
dySeries('MVP2', label = 'MRP2', col = "green") %>%
dySeries('MVP3', label = 'MRP3', col = "red") %>%  
dySeries('MVP4', label = 'MRP4', col = "purple") %>%
dySeries('MVP5', label = 'MRP5', col = "blue") %>%
dySeries('TP1', label = 'TP', col = "orange", drawPoints = TRUE) %>% 
dySeries('TP2', label = 'MRRP2', col = "green", drawPoints = TRUE) %>%
dySeries('TP3', label = 'MRRP3', col = "red", drawPoints = TRUE) %>%  
dySeries('TP4', label = 'MRRP4', col = "purple", drawPoints = TRUE) %>% 
dySeries('TP5', label = 'MRRP5', col = "blue", drawPoints = TRUE) %>%  
dySeries('EWQ', label = 'EWQ', col = "black") %>% 
dyRangeSelector(height = 30)%>%
  dyLegend(width = 500)

Choose cummulative return from volatility correlations - highest mean

CumReturnVolCorr_high_mean <- cumsum(TP2)
CumReturnVolCorr_high_mean
##  [1]  0.022313395  0.003878189  0.031195653  0.032326703  0.046734497
##  [6]  0.067244348  0.068972171  0.085966837  0.071550671  0.062707987
## [11]  0.045353192  0.040317851  0.036734225  0.042162107  0.033915290
## [16]  0.023346051  0.030943796 -0.024440322 -0.003530524 -0.042131925
## [21] -0.016461258  0.025834023  0.016431424  0.048563078  0.043686217
## [26]  0.030714280  0.019015077  0.031568669  0.020206226  0.018830413
## [31]  0.027329757  0.070652416  0.124357773  0.135949347  0.119963307
## [36]  0.159686420  0.206195258  0.220152611  0.229560397  0.216199970
## [41]  0.229899711  0.217129455  0.239133065  0.247946608  0.285165088
## [46]  0.290879226  0.256469085  0.268900127  0.260895710  0.283519282
## [51]  0.284244813  0.279033876  0.314371789  0.347447730  0.309306495
## [56]  0.303841784  0.306284056  0.320085213  0.322406046  0.318866402
## [61]  0.339206344

Merge and create a new dataframe for Without and With clustering

# Example data
CumReturnVolCorr <- data.frame(
  Date = as.character(TestDates),
  low_avg_risk = CumReturnVolCorr_low_avg_risk,
  low_risk = CumReturnVolCorr_low_risk,
  high_mean = CumReturnVolCorr_high_mean
)

Plot

library(ggplot2)

# Create the plot with date interval
ggplot(data = CumReturnVolCorr, aes(x = as.Date(Date))) +
  geom_line(aes(y = low_avg_risk, color = "low_avg_risk"), lwd = 1.5) +
  geom_line(aes(y = low_risk, color = "low_risk"), lwd = 1.5) +
  geom_line(aes(y = high_mean, color = "high_mean"), lwd = 1.5) + 
  labs(y = "Cumulative Return",
       x = "Date") +
  scale_color_manual(name = "Data",
                     values = c("low_avg_risk" = "blue", 
                                "low_risk" = "red", 
                                "high_mean" = "green"), # Add color for the new series
                     labels = c("low_avg_risk" = "lowest average risk", 
                                "low_risk" = "lowest risk", 
                                "high_mean" = "highest mean")) + # Adjust labels
  scale_x_date(date_breaks = "1 month", date_labels = "%Y-%m") + # Show dates at monthly intervals
  theme_minimal()